fluxe.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\fluxe.f
00002 !
00045                      SUBROUTINE FLUXE
00046 !                    ****************
00047 !
00048      &(HJ,UJ,VJ,HI,UI,VI,XN,YN,RNORM,G,FLULOC)
00049 !
00050 !***********************************************************************
00051 ! TELEMAC2D   V6P1                                   21/08/2010
00052 !***********************************************************************
00053 !
00054 !
00055 !
00056 !
00057 !
00058 !
00059 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00060 !| FLULOC         |<->| LOCAL FLUX AT THE INTERFACE OF IJ
00061 !| G              |-->| GRAVITY
00062 !| HI             |-->| WATER DEPTH OF NODE I
00063 !| HJ             |-->| WATER DEPTH OF NODE J
00064 !| RNORM          |---|  ???? NOT USED
00065 !| UI             |-->| VELOCITY X-COMPONENT OF NODE I
00066 !| UJ             |-->| VELOCITY X-COMPONENT OF NODE J
00067 !| VI             |-->| VELOCITY Y-COMPONENT OF NODE I
00068 !| VJ             |-->| VELOCITY Y-COMPONENT OF NODE J
00069 !| XN             |-->| X-COMPONENT OF THE NORMAL VECTOR
00070 !| YN             |-->| Y-COMPONENT OF THE NORMAL VECTOR
00071 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00072 !
00073       IMPLICIT NONE
00074 !
00075 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00076 !
00077       DOUBLE PRECISION, INTENT(INOUT) :: FLULOC(3)
00078       DOUBLE PRECISION, INTENT(IN) :: G,HI,HJ,UI,UJ,VI,VJ,RNORM
00079       DOUBLE PRECISION, INTENT(IN) :: XN,YN
00080 !
00081 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00082 !
00083       DOUBLE PRECISION RI,RJ,CT2,UT,VT,RLAMB0
00084       DOUBLE PRECISION CT,PRII,PRIJ,ALPHA
00085       DOUBLE PRECISION RLAMBM,PS,SA,RLAMBP,TW(3)
00086       DOUBLE PRECISION TR(3),T(3),CI2,CI,CJ,CJ2,RLAMBI,RLAMBJ
00087 !
00088 !-----------------------------------------------------------------------
00089 !
00090 !   --->    COMPUTES THE AVERAGES OF ROE OF U,V,H,C**2 AND C
00091 !           ---------------------------------------------
00092 !
00093       IF(HI.LE.0.D0) THEN
00094         RI = 0.D0
00095       ELSE
00096         RI = SQRT ( HI )
00097       ENDIF
00098       IF (HJ.LE.0.D0) THEN
00099         RJ = 0.D0
00100       ELSE
00101         RJ = SQRT ( HJ )
00102       ENDIF
00103 !
00104       UT = ( RI * UI + RJ * UJ ) /(RI + RJ)
00105       VT = ( RI * VI + RJ * VJ ) /(RI + RJ)
00106       IF (HI+HJ.LE.0.D0)  THEN
00107         CT2= 0.D0
00108       ELSE
00109       CT2 = G*(HI+HJ)/2.D0
00110       ENDIF
00111       CT = SQRT ( CT2 )
00112 !
00113 !   --->  TESTS THE SIGN OF THE EIGENVALUE LAMB0 =
00114 !           ----------------------------------------------------------
00115 !
00116       RLAMB0 = UT * XN + VT * YN
00117 !
00118 !TBTB BEGINNING: MODIFICATION OF RLAMB0 IF RLAMB0
00119 !C     IT IS NECESSARY TO ADD FLUXES FOR THE DUPLICATED EIGENVALUES
00120 !C     TO BE COMPLETED BY WHOEVER WISHES TO
00121 !C
00122 !TBTB END
00123 !
00124 !---------------------------------------------------------------------
00125       IF  ( RLAMB0 . GE .-0.000001D0 ) THEN
00126 !     ---- END SEGMENT ---------
00127 !
00128 !   --->    SMALL CALCULATIONS
00129 !
00130         RLAMBM = RLAMB0 - CT
00131 !
00132         PRII = G*(HI**2)/2.D0
00133         PRIJ = G*(HJ**2)/2.D0
00134         ALPHA = UI * XN + VI * YN
00135 !
00136 !TBTB BEGINNING : MODIFICATION OF RLAMBM IF RLAMBM
00137 !
00138         IF (HI.LE.0.D0) THEN
00139         CI2 = 0.D0
00140         PRII = 0.D0
00141         ELSE
00142         CI2 =  2.D0*PRII / HI
00143         ENDIF
00144         IF (HJ.LE.0.D0) THEN
00145         CJ2 = 0.D0
00146         PRIJ = 0.D0
00147         ELSE
00148         CJ2 =  2.D0*PRIJ / HJ
00149         ENDIF
00150         CI = SQRT (CI2)
00151         CJ = SQRT (CJ2)
00152         RLAMBI = ALPHA - CI
00153         RLAMBJ = UJ * XN + VJ * YN - CJ
00154 !
00155         IF ( RLAMBI .LT. 0.D0 .AND. RLAMBJ .GT. 0.D0) THEN
00156           RLAMBM = MIN(0.D0,RLAMBM) - ABS(RLAMBI - RLAMBJ) / 4.D0
00157         ENDIF
00158 !     END
00159 !
00160 !   --->    COMPUTES FLUX 1
00161 !
00162         FLULOC(1) = ALPHA * HI
00163         FLULOC(2) = ALPHA * HI*UI
00164         FLULOC(3) = ALPHA * HI*VI
00165 !
00166         FLULOC (2) = FLULOC(2) + PRII * XN
00167         FLULOC (3) = FLULOC(3) + PRII * YN
00168 !
00169 !   --->    TESTS THE SIGN OF LAMBDAM
00170 !           ----------------------------
00171 !
00172         IF ( RLAMBM . LT . 0.D0 ) THEN
00173 !       - - - - - - - - - - - - - -
00174 !
00175           T (1) = 1.D0
00176           T (2) = UT - CT * XN
00177           T (3) = VT - CT * YN
00178 !
00179           TR(1) = HJ-HI
00180           TR(2) = HJ*UJ-HI*UI
00181           TR(3) = HJ*VJ-HI*VI
00182 !
00183           TW(1) = (UT*XN + VT*YN)*CT + CT2
00184           TW(2) = -XN*CT
00185           TW(3) = -YN*CT
00186 !
00187           PS = TR(1)*TW(1)+TR(2)*TW(2)+TR(3)*TW(3)
00188 !
00189 !   --->    COMPUTES TOTAL LOCAL FLUX
00190 !           --------------------------
00191 !
00192           SA = PS * RLAMBM / (2.D0 * CT2 )
00193           FLULOC(1)= FLULOC(1)+SA*T(1)
00194           FLULOC(2)= FLULOC(2)+SA*T(2)
00195           FLULOC(3)= FLULOC(3)+SA*T(3)
00196 !
00197 !
00198         ENDIF
00199 !           -----
00200 !
00201 !      TESTEST
00202       ELSE
00203 !      TESTEST
00204 !
00205 !   --->    SMALL CALCULATIONS
00206 !           --------------
00207 !
00208         RLAMBP = RLAMB0 + CT
00209 !
00210 !
00211         ALPHA = UJ * XN + VJ* YN
00212 !
00213         IF (HI.LE.0.D0) THEN
00214           CI2 = 0.D0
00215         ELSE
00216           CI2 = G*HI
00217         ENDIF
00218         CI = SQRT (CI2)
00219         IF (HJ.LE.0.D0) THEN
00220         CJ2 = 0.D0
00221         PRIJ = 0.D0
00222         ELSE
00223         CJ2 = G*HJ
00224         PRIJ = G*(HJ**2)/2.D0
00225         ENDIF
00226         CJ = SQRT (CJ2)
00227         RLAMBI = UI * XN + VI * YN + CI
00228         RLAMBJ = ALPHA + CJ
00229 !
00230         IF ( RLAMBI .LT. 0. .AND. RLAMBJ .GT. 0.) THEN
00231           RLAMBP = MAX(0.D0,RLAMBP) + ABS(RLAMBI - RLAMBJ) / 4.
00232         ENDIF
00233 !
00234 !   --->    COMPUTES FLUX 1
00235 !           ----------------
00236 !
00237         FLULOC(1) = ALPHA * HJ
00238         FLULOC(2) = ALPHA * HJ*UJ
00239         FLULOC(3) = ALPHA * HJ*VJ
00240 !
00241         FLULOC (2) = FLULOC(2) + PRIJ * XN
00242         FLULOC (3) = FLULOC(3) + PRIJ * YN
00243 !
00244 !   --->    TESTS THE SIGN OF LAMBDAP
00245 !           ----------------------------
00246 !
00247         IF ( RLAMBP . GT . 0.D0 ) THEN
00248 !       - - - - - - - - - - - - - -
00249 !
00250           T(1) = 1.D0
00251           T(2) = UT + CT * XN
00252           T(3) = VT + CT * YN
00253 !
00254           TR(1) = HJ-HI
00255           TR(2) = HJ*UJ-HI*UI
00256           TR(3) = HJ*VJ-HI*VI
00257 !
00258           TW(1) = (-UT*XN - VT*YN)*CT +CT2
00259           TW(2) = CT*XN
00260           TW(3) = CT*YN
00261 !
00262           PS = TR(1)*TW(1)+TR(2)*TW(2)+TR(3)*TW(3)
00263 !
00264 !   --->    COMPUTES TOTAL LOCAL FLUX
00265 !           --------------------------
00266 !
00267           SA = - PS * RLAMBP / (2.D0 * CT2 )
00268           FLULOC(1)= FLULOC(1)+SA*T(1)
00269           FLULOC(2)= FLULOC(2)+SA*T(2)
00270           FLULOC(3)= FLULOC(3)+SA*T(3)
00271 !
00272         ENDIF
00273 !           -----
00274       ENDIF
00275 !
00276 !---------------------------------------------------------------------
00277 !
00278       RETURN
00279       END

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