friction_unif.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\friction_unif.f
00002 !
00072                      SUBROUTINE FRICTION_UNIF
00073 !                    ************************
00074 !
00075      &(MESH,H,U,V,CHESTR,S,KFROT,KFROTL,ITURB,LISRUG,LINDNER,
00076      & SB,NDEF,DP,SP,VK,KARMAN,GRAV,T1,T2,CHBORD,CF,CFBOR)
00077 !
00078 !***********************************************************************
00079 ! TELEMAC2D   V7P0
00080 !***********************************************************************
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00088 !| CF             |<--| ADIMENSIONAL FRICTION COEFFICIENT
00089 !| CFBORD         |<--| ADIMENSIONAL FRICTION COEFFICIENT ON BOUNDARIES
00090 !| CHBORD         |-->| DEFAULT'S MANNING ON BOUNDARY
00091 !| CHESTR         |-->| FRICTION COEFFICIENTS
00092 !| DP             |-->| DIAMETER OF ROUGHNESS ELEMENT
00093 !| GRAV           |-->| GRAVITY
00094 !| H              |-->| WATER DEPTH
00095 !| ITURB          |---| NOT USED !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
00096 !| KARMAN         |-->| VON KARMAN CONSTANT
00097 !| KFROT          |-->| LAW OF BOTTOM FRICTION
00098 !| LINDNER        |-->| IF YES, THERE IS NON-SUBMERGED VEGETATION FRICTION
00099 !| LISRUG         |-->| TURBULENCE REGIME (1: SMOOTH 2: ROUGH)
00100 !| MESH           |-->| MESH STRUCTURE
00101 !| NDEF           |-->| DEFAULT'S MANNING
00102 !| S              |-->| VOID BIEF_OBJ STRUCTURE
00103 !| SB             |---| NOT USED !!!!!!!!!!!!!!!!!!!!!!
00104 !| SP             |-->| SPACING OF ROUGHNESS ELEMENT
00105 !| T1             |<->| WORK ARRAY IN A BIEF_OBJ STRUCTURE
00106 !| T2             |<->| WORK ARRAY IN A BIEF_OBJ STRUCTURE
00107 !| U              |-->| X-COMPONENT OF VELOCITY
00108 !| V              |-->| Y-COMPONENT OF VELOCITY
00109 !| VK             |-->| KINEMATIC VISCOSITY
00110 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00111 !
00112       USE INTERFACE_TELEMAC2D, EX_FRICTION_UNIF => FRICTION_UNIF
00113 !
00114       USE BIEF
00115 !
00116       USE DECLARATIONS_TELEMAC2D, ONLY : FRICOU,NPOIN, ORBVEL
00117 !
00118       IMPLICIT NONE
00119       INTEGER LNG,LU
00120       COMMON/INFO/LNG,LU
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       TYPE(BIEF_MESH),  INTENT(IN)      :: MESH
00125       TYPE(BIEF_OBJ),   INTENT(IN)      :: H,U,V,CHESTR,CHBORD,S
00126       INTEGER,          INTENT(IN)      :: KFROT,KFROTL,ITURB,LISRUG
00127       LOGICAL,          INTENT(IN)      :: LINDNER
00128       DOUBLE PRECISION, INTENT(IN)      :: NDEF,DP,SP
00129       DOUBLE PRECISION, INTENT(IN)      :: VK,KARMAN,GRAV
00130 !
00131       DOUBLE PRECISION, INTENT(INOUT)   :: SB
00132       TYPE(BIEF_OBJ),   INTENT(INOUT)   :: T1, T2
00133 !
00134       TYPE(BIEF_OBJ),   INTENT(INOUT)   :: CF, CFBOR
00135 !
00136 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00137 !
00138       INTEGER          :: IELMC,IELMH,I
00139       DOUBLE PRECISION :: C,CP
00140 !
00141 !=======================================================================!
00142 !=======================================================================!
00143 !                               PROGRAMME                               !
00144 !=======================================================================!
00145 !=======================================================================!
00146 !
00147 ! ======================================= !
00148 ! INITIALIZATION AND DISCRETIZATION CHECK !
00149 ! ======================================= !
00150 !
00151 ! ELEMENT TYPE
00152 ! ------------
00153       IELMC = CF%ELM
00154       IELMH = H%ELM
00155 !
00156 ! SAME DISCRETIZATION FOR WATER DEPTH AND FRICTION COEFFICIENT IF NEEDED
00157 ! ----------------------------------------------------------------------
00158       IF (KFROT.NE.0.AND.KFROT.NE.2) THEN
00159 !
00160 ! MAXIMUM BETWEEN WATER DEPTH AND 1.D-4
00161 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00162         CALL CPSTVC(H,T1)
00163         CALL OS('X=Y     ', T1, H, S, C)
00164         IF(IELMC.NE.IELMH) CALL CHGDIS( T1 , IELMH , IELMC , MESH )
00165 !       NIKURADSE LAW WILL DO ITS OWN CLIPPING
00166         IF(KFROT.NE.5) THEN
00167           CALL OS('X=+(Y,C)', T1, T1, S, 1.D-4)
00168         ENDIF
00169       ENDIF
00170 !
00171 ! RESULTANT VELOCITY IN T2
00172 ! ------------------------
00173       IF (KFROT.EQ.1.OR.KFROT.EQ.6.OR.KFROT.EQ.7) THEN
00174         CALL CPSTVC(CF,T2)
00175         CALL OS('X=N(Y,Z)', T2,  U, V, C)
00176         CALL OS('X=+(Y,C)', T2, T2, S, 1.D-6)
00177       ENDIF
00178 !
00179 ! =============== !
00180 ! BOTTOM FRICTION !
00181 ! =============== !
00182 !
00183 !     FRICTION COEFFICIENT FOR THE BOTTOM
00184 !     -----------------------------------
00185 !
00186       CALL FRICTION_CALC(1, CF%DIM1, KFROT, NDEF, VK, GRAV,
00187      &                   KARMAN, CHESTR, T1, T1, T2, CF)
00188 !
00189 !     FRICTION COEFFICIENT FOR NON-SUBMERGED VEGETATION
00190 !     -------------------------------------------------
00191 !
00192       IF(LINDNER) THEN
00193 !
00194         DO I = 1, CF%DIM1
00195           CALL FRICTION_LINDNER(T2%R(I),T1%R(I),CF%R(I),
00196      &                          VK,GRAV,DP,SP,CP)
00197           IF(CP.LT.-0.9D0) THEN
00198             CP = 0.75D0*T1%R(I)*DP/(SP**2)
00199           ENDIF
00200           CF%R(I) = (CF%R(I)+2.D0*CP)
00201         ENDDO
00202       ENDIF
00203 !
00204 !     CV
00205 !     WAVE INDUCED FRICTION ENHANCMENT (OCONNOR AND YOO, 1988)
00206 !
00207       IF(FRICOU)THEN
00208         CALL CPSTVC(CF,T2)
00209         CALL OS('X=N(Y,Z)', T2,  U, V, C)
00210         CALL OS('X=+(Y,C)', T2, T2, S, 1.D-6)
00211         DO I=1,NPOIN
00212           CF%R(I)=CF%R(I)*(1.D0 + 0.72D0*ORBVEL%R(I)/T2%R(I))
00213         ENDDO
00214       ENDIF
00215 !
00216 ! ============= !
00217 ! WALL FRICTION !
00218 ! ============= !
00219 !
00220 ! WALL FRICTION COMPUTATION
00221 ! -------------------------
00222 !
00223       IF(LISRUG.EQ.2) THEN
00224         CALL FRICTION_CALC(1,MESH%NPTFR,KFROTL,NDEF,VK,GRAV,
00225      &                     KARMAN,CHBORD,MESH%DISBOR,T1,T2,CFBOR)
00226       ENDIF
00227 !
00228 !=======================================================================!
00229 !=======================================================================!
00230 !
00231       RETURN
00232       END

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