friction_bubble.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\friction_bubble.f
00002 !
00054                      SUBROUTINE FRICTION_BUBBLE
00055 !                    **************************
00056 !
00057      &(IKLE, NPOIN, NELEM, NELMAX, LINDNER, NKFROT, CHESTR, NDEFMA,
00058      & LINDDP, LINDSP)
00059 !
00060 !***********************************************************************
00061 ! TELEMAC2D   V6P1                                   21/08/2010
00062 !***********************************************************************
00063 !
00064 !
00065 !
00066 !
00067 !
00068 !
00069 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00070 !| CHESTR         |<->| FRICTION COEFFICIENTS
00071 !| IKLE           |-->| CONNECTIVITY TABLE.
00072 !| LINDDP         |<--| DIAMETER OF ROUGHNESS ELEMENT IN LINDNER CASE
00073 !| LINDNER        |-->| IF YES, THERE IS NON-SUBMERGED VEGETATION FRICTION
00074 !| LINDSP         |<--| SPACING OF ROUGHNESS ELEMENT IN LINDNER CASE
00075 !| NDEFMA         |<--| DEFAULT MANNING COEFFICIENT
00076 !| NELEM          |-->| NUMBER OF ELEMENTS
00077 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00078 !| NKFROT         |<->| LAW OF BOTTOM FRICTION FOR EVERY POINT
00079 !| NPOIN          |-->| NUMBER OF POINTS
00080 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00081 !
00082       USE BIEF
00083       IMPLICIT NONE
00084       INTEGER LNG,LU
00085       COMMON/INFO/LNG,LU
00086 !
00087 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00088 !
00089       TYPE(BIEF_OBJ), INTENT(IN)    :: IKLE
00090       INTEGER,        INTENT(IN)    :: NPOIN, NELEM, NELMAX
00091       LOGICAL,        INTENT(IN)    :: LINDNER
00092       TYPE(BIEF_OBJ), INTENT(INOUT) :: NKFROT, CHESTR, NDEFMA
00093       TYPE(BIEF_OBJ), INTENT(INOUT) :: LINDDP, LINDSP
00094 !
00095 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00096 !
00097       INTEGER :: I, I1, I2, I3
00098 !
00099 !=======================================================================!
00100 !=======================================================================!
00101 !                               PROGRAMME                               !
00102 !=======================================================================!
00103 !=======================================================================!
00104 !
00105       DO I = NPOIN + 1, NPOIN + NELEM
00106 !
00107         I1 = IKLE%I(I - NPOIN           )
00108         I2 = IKLE%I(I - NPOIN +   NELMAX)
00109         I3 = IKLE%I(I - NPOIN + 2*NELMAX)
00110 !
00111         ! COMPUTING THE VALUES OF THE MIDDLE-NODE
00112         ! ---------------------------------------
00113         IF (NKFROT%I(I1).EQ.NKFROT%I(I2)) THEN
00114           ! THE 3 NODES HAVE THE SAME LAW !
00115           ! ***************************** !
00116           IF (NKFROT%I(I1).EQ.NKFROT%I(I3))THEN
00117 !
00118             NKFROT%I(I) = NKFROT%I(I1)
00119             CHESTR%R(I) = (CHESTR%R(I3) + CHESTR%R(I2) +CHESTR%R(I1))
00120      &                  / 3.D0
00121             NDEFMA%R(I) = (NDEFMA%R(I3) + NDEFMA%R(I2) +NDEFMA%R(I1))
00122      &                  / 3.D0
00123 !
00124             IF (LINDNER) THEN
00125               LINDDP%R(I) = ( LINDDP%R(I3) + LINDDP%R(I2)
00126      &                       +LINDDP%R(I1) )/3.D0
00127 !
00128               LINDSP%R(I) = ( LINDSP%R(I3) + LINDSP%R(I2)
00129      &                       +LINDSP%R(I1) )/3.D0
00130             ENDIF
00131 !
00132           ! THE NODES "1" AND "2" HAVE THE SAME LAW !
00133           ! *************************************** !
00134           ELSE
00135             NKFROT%I(I) = NKFROT%I(I1)
00136             CHESTR%R(I) = (CHESTR%R(I2) + CHESTR%R(I1))/2.D0
00137             NDEFMA%R(I) = (NDEFMA%R(I2) + NDEFMA%R(I1))/2.D0
00138 !
00139             IF (LINDNER) THEN
00140               LINDDP%R(I) = (LINDDP%R(I2) + LINDDP%R(I1))/2.D0
00141               LINDSP%R(I) = (LINDSP%R(I2) + LINDSP%R(I1))/2.D0
00142             ENDIF
00143           ENDIF
00144 !
00145         ! THE NODES "2" AND "3" HAVE THE SAME LAW !
00146         ! *************************************** !
00147         ELSE IF (NKFROT%I(I2).EQ.NKFROT%I(I3)) THEN
00148 !
00149           NKFROT%I(I) = NKFROT%I(I2)
00150           CHESTR%R(I) = (CHESTR%R(I3) + CHESTR%R(I2))/2.D0
00151           NDEFMA%R(I) = (NDEFMA%R(I3) + NDEFMA%R(I2))/2.D0
00152 !
00153           IF (LINDNER) THEN
00154             LINDDP%R(I) = (LINDDP%R(I3) + LINDDP%R(I2))/2.D0
00155             LINDSP%R(I) = (LINDSP%R(I3) + LINDSP%R(I2))/2.D0
00156           ENDIF
00157 !
00158         ! THE 3 NODES HAVE DIFFERENT LAWS : VALUE OF THE NODE "1" KEPT !
00159         ! ************************************************************ !
00160         ELSE
00161           NKFROT%I(I) = NKFROT%I(I1)
00162           CHESTR%R(I) = CHESTR%R(I1)
00163           NDEFMA%R(I) = NDEFMA%R(I1)
00164 !
00165           IF (LINDNER) THEN
00166             LINDDP%R(I) = LINDDP%R(I1)
00167             LINDSP%R(I) = LINDSP%R(I1)
00168           ENDIF
00169         ENDIF
00170       ENDDO
00171 !
00172 !=======================================================================!
00173 !=======================================================================!
00174 !
00175       RETURN
00176       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0