fricti.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\fricti.f
00002 !
00070                      SUBROUTINE FRICTI
00071 !                    *****************
00072 !
00073      &(FU_IMP,FV_IMP,FUDRAG,FVDRAG,UN,VN,HN,CF,MESH,T1,T2,VERTIC,
00074      & UNSV2D,MSK,MASKEL,HFROT)
00075 !
00076 !***********************************************************************
00077 ! TELEMAC2D   V6P1                                   21/08/2010
00078 !***********************************************************************
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00088 !| CF             |-->| COEFFICIENT DE FROTTEMENT VARIABLE EN ESPACE
00089 !| FUDRAG         |<--| DRAG FORCE ALONG X
00090 !| FU_IMP         |<--| IMPLICIT SOURCE TERM DUE TO FRICTION, ALONG X
00091 !| FVDRAG         |<--| DRAG FORCE ALONG Y
00092 !| FV_IMP         |<--| IMPLICIT SOURCE TERM DUE TO FRICTION, ALONG Y
00093 !| HFROT          |-->| KEY-WORD 'DEPTH IN FRICTION TERMS'
00094 !| HN             |-->| WATER DEPTH AT TIME TN
00095 !| MASKEL         |-->| MASKING OF ELEMENTS
00096 !|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
00097 !| MESH           |-->| MESH STRUCTURE
00098 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00099 !| T1             |<->| WORK BIEF_OBJ STRUCTURE
00100 !| T2             |<->| WORK BIEF_OBJ STRUCTURE
00101 !| UNSV2D         |-->| INVERSE OF INTEGRALS OF TEST FUNCTIONS
00102 !| VERTIC         |-->| IF YES TAKE INTO ACCOUNT VERTICAL STRUCTURES
00103 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00104 !
00105       USE BIEF
00106       USE INTERFACE_TELEMAC2D, EX_FRICTI => FRICTI
00107 !
00108       IMPLICIT NONE
00109       INTEGER LNG,LU
00110       COMMON/INFO/LNG,LU
00111 !
00112 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00113 !
00114       LOGICAL, INTENT(IN)                 :: VERTIC,MSK
00115       INTEGER, INTENT(IN)                 :: HFROT
00116       TYPE(BIEF_OBJ),  INTENT(IN)         :: UN,VN,CF,UNSV2D,MASKEL
00117       TYPE(BIEF_OBJ),  INTENT(IN), TARGET :: HN
00118       TYPE(BIEF_OBJ),  INTENT(INOUT)      :: FU_IMP,FV_IMP,FUDRAG,FVDRAG
00119       TYPE(BIEF_OBJ),  INTENT(INOUT), TARGET :: T1,T2
00120       TYPE(BIEF_MESH), INTENT(INOUT)      :: MESH
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       INTEGER N,IELMU,IELMH,IELMS
00125 !
00126       DOUBLE PRECISION UNORM,H,HO
00127 !
00128       INTRINSIC SQRT,MAX
00129 !
00130       TYPE(BIEF_OBJ), POINTER :: HHN
00131 !
00132 !-----------------------------------------------------------------------
00133 !
00134       IELMU=UN%ELM
00135       IELMH=HN%ELM
00136       IELMS=CF%ELM
00137 !
00138 !     SETUP THE WATE DEPTH WITH THE SAME DISCRETIZATION
00139 !
00140       IF(IELMH.NE.IELMU) THEN
00141         CALL OS( 'X=Y     ' , X=T1 , Y=HN )
00142         CALL CHGDIS( T1 , IELMH , IELMU , MESH )
00143         HHN=>T1
00144       ELSE
00145         HHN=>HN
00146       ENDIF
00147 !
00148       IF(IELMS.NE.IELMU) THEN
00149         IF (LNG.EQ.1) WRITE(LU,200) IELMS,IELMU
00150         IF (LNG.EQ.2) WRITE(LU,201) IELMS,IELMU
00151 200     FORMAT(1X,'FRICTI : DISCRETISATION DU FROTTEMENT : ',1I6,/,
00152      &         1X,'DIFFERENTE DE CELLE DE U : ',1I6)
00153 201     FORMAT(1X,'FRICTI: DISCRETIZATION OF FRICTION:',1I6,/,
00154      &         1X,'DIFFERENT FROM U: ',1I6)
00155         CALL PLANTE(1)
00156         STOP
00157       ENDIF
00158 !
00159 !-----------------------------------------------------------------------
00160 !
00161 !     FU_IMP AND FV_IMP ARE WORKING ARRAYS
00162 !
00163       CALL CPSTVC(UN,FU_IMP)
00164       CALL CPSTVC(VN,FV_IMP)
00165 !
00166 !-----------------------------------------------------------------------
00167 !
00168 !     BEWARE: HO HIDDEN PARAMETER
00169 !
00170       HO = 3.D-2
00171 !
00172       IF(HFROT.EQ.1) THEN
00173         DO N=1,UN%DIM1
00174           UNORM = SQRT(UN%R(N)**2+VN%R(N)**2)
00175           H = MAX(HHN%R(N),1.D-9)
00176 !         MODIFICATION BY JMH ON 06/08/04
00177 !         FOLLOWING LINE TO KEEP A FRICTION ON TIDAL FLATS, IF UNORM=0
00178 !         IDEA : IF TOO SMALL, UNORM PROGRESSIVELY REPLACED BY SQRT(G*H)
00179 !         WHEN H TENDS TO 0. LITTLE CHANGE, BUT BIG EFFECT ON UNORM/H
00180           IF(H.LT.HO) UNORM=MAX(UNORM,SQRT(9.81D0*(HO-H)*H/HO))
00181           FU_IMP%R(N) = - 0.5D0 * CF%R(N) * UNORM / H
00182           FV_IMP%R(N) = FU_IMP%R(N)
00183         ENDDO
00184       ELSEIF(HFROT.EQ.2) THEN
00185         CALL VECTOR(T2,'=','MASVEC          ',IELMH,
00186      &              1.D0,HN,HN,HN,HN,HN,HN,MESH,MSK,MASKEL)
00187         IF(NCSIZE.GT.1) CALL PARCOM(T2,2,MESH)
00188         CALL OS('X=XY    ',X=T2,Y=UNSV2D)
00189         IF(IELMH.NE.IELMU) THEN
00190           CALL CHGDIS( T2 , IELMH , IELMU , MESH )
00191         ENDIF
00192         DO N=1,UN%DIM1
00193           UNORM = SQRT(UN%R(N)**2+VN%R(N)**2)
00194 !         SMOOTHED OR AVERAGE DEPTH
00195           H = MAX(T2%R(N),1.D-9)
00196           IF(H.LT.HO) UNORM=MAX(UNORM,SQRT(9.81D0*(HO-H)*H/HO))
00197           FU_IMP%R(N) = - 0.5D0 * CF%R(N) * UNORM / H
00198           FV_IMP%R(N) = FU_IMP%R(N)
00199         ENDDO
00200       ELSE
00201         WRITE(LU,*) 'FRICTI : PARAMETRE HFROT INCONNU : ',HFROT
00202         WRITE(LU,*) 'FRICTI: UNKNOWN PARAMETER HFROT:',HFROT
00203         CALL PLANTE(1)
00204         STOP
00205       ENDIF
00206 !
00207 !-----------------------------------------------------------------------
00208 !
00209       IF(VERTIC) THEN
00210         CALL CPSTVC(UN,FUDRAG)
00211         CALL CPSTVC(VN,FVDRAG)
00212         CALL DRAGFO(FUDRAG,FVDRAG)
00213       ENDIF
00214 !
00215 !-----------------------------------------------------------------------
00216 !
00217       RETURN
00218       END

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