flux_tch.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\flux_tch.f
00002 !
00069                      SUBROUTINE FLUX_TCH
00070 !                    *******************
00071 !
00072      &(X,Y,NS,NSEG,NELEM,NUBO,G,W,ZF,VNOCL,
00073      & ELTSEG,CE,IFABOR)
00074 !
00075 !***********************************************************************
00076 ! TELEMAC-2D VERSION 6.2                                     03/15/2011
00077 !***********************************************************************
00078 !
00079 !       REF.:"MODELING OF WETTING-DRYING TRANSITIONS IN FREE SURFACE FLOWS
00080 !             OVER COMPLEX TOPOGRAPHIES" CMAME 199(2010) PP 2281-2304
00081 !
00082 !
00083 !
00084 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00085 !|  NS            |-->|  TOTAL NUMBER OF NODES
00086 !|  NSEG          |-->|  TOTAL NUMBER OF EDGES
00087 !|  NUBO          |-->|  GLOBAL NUMBERS (INDEX) OF EDGE EXTREMITIES
00088 !|  G             |-->|  GRAVITY CONSTANT
00089 !|  W             |-->|  (H,HU,HV)
00090 !|  ZF            |-->|  BATHYMETRIES
00091 !|  VNOCL         |-->|  OUTWARD UNIT NORMAL (XNN,YNN, SEGMENT LENGTH)
00092 !|  CE            |<--|  FLUX INCREMENT
00093 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00094 !
00095       USE INTERFACE_TELEMAC2D, EX_FLUX_TCH => FLUX_TCH
00096       USE BIEF_DEF, ONLY:NCSIZE
00097 !
00098       IMPLICIT NONE
00099       INTEGER LNG,LU
00100       COMMON/INFO/LNG,LU
00101 !
00102 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00103 !
00104       INTEGER, INTENT(IN)             :: NS,NSEG,NELEM
00105       INTEGER, INTENT(IN)             :: NUBO(2,NSEG)
00106       INTEGER, INTENT(IN)             :: ELTSEG(NELEM,3)
00107       DOUBLE PRECISION, INTENT(IN)    :: ZF(NS),VNOCL(3,NSEG)
00108       DOUBLE PRECISION, INTENT(IN)    :: G,W(3,NS)
00109       DOUBLE PRECISION, INTENT(IN)    :: X(NS),Y(NS)
00110       DOUBLE PRECISION, INTENT(INOUT) :: CE(NS,3)
00111       INTEGER, INTENT(IN)             :: IFABOR(NELEM,3)
00112 !
00113 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00114 !
00115       INTEGER NSG,NUBO1,NUBO2,IVAR,I,IDRY
00116       INTEGER IEL,IER
00117 !
00118       DOUBLE PRECISION ZF1,ZF2,XNN,YNN,RNN
00119       DOUBLE PRECISION V21,V22,V31,V32,DEMI
00120       DOUBLE PRECISION H1,H2,EPS,FLXI(3),FLXJ(3)
00121       DOUBLE PRECISION ETA1,ETA2,PROD_SCAL
00122       LOGICAL,ALLOCATABLE ::   YESNO(:)
00123 !
00124 !-----------------------------------------------------------------------
00125 !
00126       EPS=1.E-6
00127       DEMI = 0.5D0
00128       ALLOCATE(YESNO(NSEG),STAT=IER)
00129       IF(IER.NE.0)THEN
00130         IF(LNG.EQ.1)WRITE(LU,*)'FLUX_TCH: ERREUR D''ALLOCATION'
00131         IF(LNG.EQ.2)WRITE(LU,*)'FLUX_TCH: ALLOCATION ERROR '
00132         CALL PLANTE(1)
00133         STOP
00134       ENDIF
00135 !
00136 ! INITIALIZATION OF CE
00137 !
00138       DO I=1,3
00139         DO IVAR=1,NS
00140           CE(IVAR,I) = 0.D0
00141         ENDDO
00142       ENDDO
00143 ! INITIALIZATION OF YESNO
00144       DO I=1,NSEG
00145         YESNO(I)=.FALSE.
00146       ENDDO
00147 !
00148 !-----------------------------------------------------------------------
00149 !
00150 !     LOOP OVER GLOBAL LIST OF EDGES
00151 !
00152       DO IEL=1, NELEM
00153         DO I = 1,3
00154           IF(.NOT.YESNO(ELTSEG(IEL,I)))THEN
00155             NSG = ELTSEG(IEL,I)
00156 !           INDICATOR FOR DRY CELLS
00157             IDRY=0
00158 !           INITIALIZATION
00159             FLXI(1)=0.D0
00160             FLXI(2)=0.D0
00161             FLXI(3)=0.D0
00162             FLXJ(1)=0.D0
00163             FLXJ(2)=0.D0
00164             FLXJ(3)=0.D0
00165             PROD_SCAL=0.D0
00166 !           RECUPERATE NODES OF THE EDGE WITH THE GOOD ORIENTATION
00167 !            WITH RESPECT TO THE NORMAL
00168             NUBO1 = NUBO(1,NSG)
00169             NUBO2 = NUBO(2,NSG)
00170             PROD_SCAL= ((X(NUBO2)-X(NUBO1))*VNOCL(1,NSG)+
00171      &                  (Y(NUBO2)-Y(NUBO1))*VNOCL(2,NSG))
00172             IF(PROD_SCAL.LT.0.D0)THEN
00173               NUBO1 = NUBO(2,NSG)
00174               NUBO2 = NUBO(1,NSG)
00175             ENDIF
00176 !           THEIR BATHYMETRIES
00177             ZF1 = ZF(NUBO1)
00178             ZF2 = ZF(NUBO2)
00179 !
00180 !           NORMAL COORDINATES NX, NY AND SEGMENT LENGTH
00181 !
00182             XNN = VNOCL(1,NSG)
00183             YNN = VNOCL(2,NSG)
00184             RNN = VNOCL(3,NSG)
00185 !
00186 !           WATER DEPTH
00187 !
00188             H1 = W(1,NUBO1)
00189             H2 = W(1,NUBO2)
00190 !
00191 !           UNKNOWN SET (V1,V2,V3)=(eta,U,V) FOR EACH NODE
00192 !
00193             ETA1 = W(1,NUBO1)+ZF1
00194             ETA2 = W(1,NUBO2)+ZF2
00195 !
00196             IF(H1.GT.EPS) THEN
00197               V21 = W(2,NUBO1)/H1
00198               V31 = W(3,NUBO1)/H1
00199             ELSE
00200               V21=0.D0
00201               V31=0.D0
00202               IDRY=IDRY+1
00203             ENDIF
00204 !
00205             IF(H2.GT.EPS)THEN
00206               V22 = W(2,NUBO2)/H2
00207               V32 = W(3,NUBO2)/H2
00208             ELSE
00209               V22=0.D0
00210               V32=0.D0
00211               IDRY=IDRY+1
00212             ENDIF
00213 !
00214 !           LOCAL FLUX COMPUTATION
00215 !
00216 !           AT LEAST ONE WET CELL
00217 !
00218             IF(IDRY.LT.2)THEN
00219               CALL FLU_TCHAMEN(H1,H2,ETA1,ETA2,V21,V22,
00220      &                         V31,V32,XNN,YNN,FLXI,FLXJ,G)
00221 !
00222 !             FOR PARALLELISM
00223 !
00224               IF(NCSIZE.GT.1)THEN
00225                 IF(IFABOR(IEL,I).EQ.-2)THEN !THIS IS INTERFACE EDGE
00226                  ! DEMI=DEMI*SIGN(1.0D0,PROD_SCAL)
00227                   FLXI(1)= DEMI*FLXI(1)
00228                   FLXI(2)= DEMI*FLXI(2)
00229                   FLXI(3)= DEMI*FLXI(3)
00230                   FLXJ(1)= DEMI*FLXJ(1)
00231                   FLXJ(2)= DEMI*FLXJ(2)
00232                   FLXJ(3)= DEMI*FLXJ(3)
00233                 ENDIF
00234               ENDIF
00235 !
00236 !             FLUX INCREMENT
00237 !
00238               CE(NUBO1,1) = CE(NUBO1,1) - RNN*FLXI(1)
00239               CE(NUBO1,2) = CE(NUBO1,2) - RNN*FLXI(2)
00240               CE(NUBO1,3) = CE(NUBO1,3) - RNN*FLXI(3)
00241 !
00242               CE(NUBO2,1) = CE(NUBO2,1) + RNN*FLXJ(1)
00243               CE(NUBO2,2) = CE(NUBO2,2) + RNN*FLXJ(2)
00244               CE(NUBO2,3) = CE(NUBO2,3) + RNN*FLXJ(3)
00245             ENDIF
00246             YESNO(NSG)=.TRUE.
00247           ENDIF
00248         ENDDO
00249       ENDDO
00250 !
00251       DEALLOCATE(YESNO)
00252 !-----------------------------------------------------------------------
00253 !
00254       RETURN
00255       END

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