resolu.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\resolu.f
00002 !
00089                         SUBROUTINE RESOLU
00090 !                       *****************
00091 !
00092      & (W,FLUSCE,NUBO,VNOIN,WINF,AT,DT,LT,
00093      &  NELEM,NSEG,NPTFR,FLUX,AIRS,AIRE,
00094      &  X,Y,IKLE,ZF,CF,NPOIN,HN,H,U,V,QU,QV,G,LISTIN,
00095      &  XNEBOR,YNEBOR,LIMPRO,NBOR,KDIR,KNEU,KDDL,
00096      &  HBOR,UBOR,VBOR,FLUSORT,FLUENT,CFLWTD,DTVARI,NELMAX,KFROT,
00097      &  NREJET,ISCE,TSCE2,MAXSCE,MAXTRA,YASMH,SMH,MASSES,
00098      &  NTRAC,DIMT,T,HTN,TN,DLIMT,
00099      &  TBOR,MASSOU,FLUTENT,FLUTSOR,DTHAUT,DPX,DPY,DJX,DJY,CMI,JMI,
00100      &  SMTR,DXT,DYT,DJXT,DJYT,
00101      &  DIFVIT,ITURB,PROPNU,DIFT,DIFNU,
00102      &  DX,DY,OPTVF,FLUSORTN,FLUENTN,
00103      &  DSZ,AIRST,HSTOK,HCSTOK,FLUXT,FLUHBOR,FLBOR,
00104      &  LOGFR,LTT,DTN,FLUXTEMP,FLUHBTEMP,
00105      &  HC,TMAX,DTT,T1,T2,T3,T4,T5,
00106      &  GAMMA,FLUX_OLD,NVMAX,NEISEG,ELTSEG,IFABOR,MESH)
00107 !
00108 !***********************************************************************
00109 ! TELEMAC2D   V7P0
00110 !***********************************************************************
00111 !
00112 !         KINETIC SCHEME (ORDER 1 OR 2) OR
00113 !        TCHAMEN/ZOKAGOA SCHEMES (ORDER 1)
00114 !        HLLC (ORDER1) OR WAF (ORDER2 IN TIME AND SPACE)
00115 !            FOR INTERIOR FLUXES
00116 !            AND OF TYPE STEGER AND WARMING FOR I/O;
00117 !+
00118 !+
00119 !+            2. SOLVES IN TIME USING A NEWMARK TYPE SCHEME OF SECOND ORDER.
00120 !
00121 !
00122 !
00123 !
00124 !
00125 !
00126 !
00127 !
00128 !
00129 ! history S.PAVAN
00130 !+        02/05/2014
00131 !+        V7P0
00132 !+    Initialization of flux_old
00133 !+    for kinetic schemes
00134 !
00135 ! history R. ATA (EDF R&D-LNHE)
00136 !+        20/06/2014
00137 !+        V7P0
00138 !+    change winf values which are directly
00139 !+    obtained by bord
00140 !+    add parcom_bor after cdl routines
00141 !+    change cdl routines to exactly impose boundary conditions
00142 !+    initiliaze QU,QV and Hn
00143 !+
00144 !
00145 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00146 !| AIRE           |-->| ELEMENT AREA
00147 !| AIRS           |-->| CELL AREA
00148 !| AIRST          |-->| AREA OF SUB-TRIANGLES (SECOND ORDER)
00149 !| AT,DT,LT       |-->| TIME, TIME STEP AND NUMBER OF THE STEP
00150 !| CF             |-->| FRICTION COEFFICIENT
00151 !| CFLWTD         |-->| WANTED CFL NUMBER
00152 !| CMI            |-->| COORDINATES OF MIDDLE PONTS OF EDGES
00153 !| DIFNU          |-->| COEFFICIENT OF DIFFUSION FOR TRACER
00154 !| DIFT           |-->| LOGICAL: DIFFUSION FOR TRACER OR NOT
00155 !| DIFVIT         |-->| LOGICAL: DIFFUSION FOR VELOCITY OR NOT
00156 !| DIMT           |-->| DIMENSION OF TRACER
00157 !| DJXT,DJYT      |---| WORKING TABLES FOR TRACER
00158 !| DLIMT          |-->| DIMENSION OF TRACER ON THE BOUNDARY
00159 !| DSZ            |<->| VARIATION OF Z FOR ORDER 2
00160 !| DTHAUT         |-->| CHARACTERISTIC LENGTH (DX) USED FOR CFL
00161 !| DTN            |<->| TIME STEP   FROM TN+1 TO TN+2
00162 !| DTT            |<->| TIME STEP FOR TRACER
00163 !| DTVARI         |-->| DT VARIALE OR NOT
00164 !| DX,DY          |---| WORKING TABLES
00165 !| DXT,DYT        |---| WORKING TABLES FOR TRACER
00166 !| FLUENT,FLUSORT |<--| MASS FLUX INLET AND OUTLET FROM TN TO TN+1
00167 !| FLUHBTEMP      |<->| BORD FLUX FOR TRACER
00168 !| FLUSCE         |-->| SOURCE FLUXES
00169 !| FLUSORTN,FLUENT|<->| MASS FLUX INLET AND OUTLET FROM TN+1 TO TN+2
00170 !| FLUTENT,FLUTSOR|<--| FLUX TRACER INLET AND OUTLET
00171 !| FLUX           |---| FLUX
00172 !| FLUXT,FLUHBOR  |<->| FLUX, FLUX BORD FOR TRACER
00173 !| FLUXTEMP       |<->| FLUX FOR TRACER
00174 !| G              |-->| GRAVITY
00175 !| H              |<--| WATER DEPTH AT TIME N+1
00176 !| HBOR           |-->| IMPOSED VALUE FOR H
00177 !| HC             |<->| H RECONSTRUCTED (ORDER 2) CORRECTED
00178 !| HN             |-->| WATER DEPTH AT TIME N
00179 !| HSTOK,HCSTOK   |<->| H, H CORRECTED TO STOCK FOR TRACER
00180 !| HTN,TN         |-->| HT, T  AT TIME N
00181 !| IKLE           |-->| INDICES OF NODES FOR TRIANGLE
00182 !| ISCE           |-->| SOURCE POINTS
00183 !| ITURB          |-->| MODEL OF TURBULENCE  1 : LAMINAIRE
00184 !| JMI            |-->| NUMBER OF THE TRIANGLE IN WHICH IS LOCATED
00185 !|                |   | THE MIDPOINT OF THE INTERFACE
00186 !| KDDL           |-->| CONVENTION FOR FREE POINTS (BC)
00187 !| KDIR           |-->| CONVENTION FOR DIRICHLET POINTS
00188 !| KFROT          |-->| BED FRICTION LAW
00189 !| KNEU           |-->| CONVENTION NEUMANN POINTS
00190 !| LIMPRO         |-->| TYPES OF BOUNDARY CONDITION
00191 !| LISTIN         |-->| IF YES, PRINT MESSAGES AT LISTING.
00192 !| LOGFR          |<->| REFERENCE OF BOUNDARY NODES
00193 !| LTT            |<->| NUMBER OF TIME STEP FOR TRACER
00194 !| MASSES         |<--| ADDED MASS BY SOURCE TERMS
00195 !| MASSOU         |<--| ADDED TRACER MASS BY SOURCE TERM
00196 !| MAXSCE         |-->| MAXIMUM NUMBER OF SOURCES
00197 !| MAXTRA         |-->| MAXIMUM NUMBER OF TRACERS
00198 !| NBOR           |-->| GLOBAL INDICES FOR BORD NODES
00199 !| NB_NEIGHB      |-->| NUMBER OF NEIGHBORING SUBDOMAINS(SHARING POINTS)
00200 !| NEISEG         |-->| NEIGHBORS OF SEGMENT (FOR LIMITER)
00201 !| NELEM          |-->| NUMBER OF ELEMENTS
00202 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00203 !| NIT            |-->| TOTAL NUMBER OF TIME STEPS
00204 !| NPOIN          |-->| TOTAL NUMBER OF NODES
00205 !| NPTFR          |-->| TOTAL NUMBER OF BOUNDARY NODES
00206 !| NREJET         |-->| NUMBER OF SOURCE/SINK
00207 !| NSEG           |-->| NUMBER OF EDGES
00208 !| NTRAC          |-->| NUMBER OF TRACERS
00209 !| NUBO           |-->| GLOBAL INDICES OF EDGE EXTREMITIES
00210 !| MVMAX          |-->| MAX NUMBER OF NEIGHBOR FOR A NODE
00211 !| OPTVF          |-->| OPTION OF THE SCHEME
00212 !|                |   | 0:ROE, 1:KINETIC ORDRE 1,2:KINETIC ORDRE 2
00213 !|                |   | 3:ZOKAGOA, 4:TCHAMEN,4:HLLC
00214 !| PROPNU         |-->| COEFFICIENT OF MOLECULAR DIFFUSION
00215 !| QU,QV          |<->| FLOW COMPOENENTS AT TIME N THEN AT TIME  N+1
00216 !| SMH            |-->| SOURCE TERMS FOR CONTINUITY EQUATION
00217 !| SMTR           |---| SOURCE TERMS FOR TRACEUR
00218 !| T              |<--| TRACER UPDATED
00219 !| T1,T2,T3,T4,T5 |---| WORKING TABLES
00220 !| TBOR           |-->| BC FOR T
00221 !| TMAX           |-->| FINAL TIME
00222 !| TSCE2          |---|
00223 !| U,V            |<--| VELOCITY COMPONENTS AT TIME N+1
00224 !| UBOR           |-->| IMPOSED VALUES FOR U
00225 !| VBOR           |-->| IMPOSED VALUES FOR V
00226 !| VNOIN          |-->| NORMAL TO THE INTERFACE
00227 !|                |   | (2 FIRS COMPOSANTES) AND
00228 !|                |   | SEGMENT LENGTH (3RD COMPONENT)
00229 !| W              |<->| WORKING TABLE
00230 !| WINF           |-->| BOUNDARY CONDITIONS COMPUTED BY BORD
00231 !| X,Y            |-->| COORDINATES FOR MESH NODES
00232 !| XNEBOR,YNEBOR  |-->| NORMAL TO BOUNDARY POINTS
00233 !| YASMH          |-->| LOGICAL: TO TAKE INTO ACCOUNT SMH
00234 !| ZF             |-->| BED TOPOGRAPHY (BATHYMETRY)
00235 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00236 !
00237       USE BIEF_DEF
00238       USE BIEF
00239       USE INTERFACE_TELEMAC2D, EX_RESOLU => RESOLU
00240 !     USE DECLARATIONS_TELEMAC2D, ONLY:DEBUG ! IF NEEDED DECOMMENT
00241 !
00242       IMPLICIT NONE
00243 !
00244       INTEGER LNG,LU
00245       COMMON/INFO/LNG,LU
00246 !
00247 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00248 !
00249       INTEGER, INTENT(IN) :: NELEM,NPOIN,NSEG,NPTFR,LT,NREJET,DIMT
00250       INTEGER, INTENT(IN) :: MAXSCE,MAXTRA,NVMAX
00251       INTEGER, INTENT(IN) :: DLIMT,OPTVF,JMI(*)
00252       INTEGER, INTENT(IN) :: KDIR,KNEU,KDDL,ITURB,NELMAX,KFROT,NTRAC
00253       INTEGER, INTENT(IN) :: NUBO(2,*),LIMPRO(NPTFR,6),NBOR(NPTFR)
00254       INTEGER, INTENT(IN) :: IKLE(NELMAX,3),ISCE(NREJET)
00255       INTEGER, INTENT(INOUT) :: LTT,LOGFR(*),NEISEG(2,NSEG)
00256       INTEGER, INTENT(IN)    :: ELTSEG(NELEM,3)
00257       INTEGER,  INTENT(IN)   :: IFABOR(NELEM,*)
00258 !
00259       LOGICAL, INTENT(IN) :: LISTIN,DTVARI,YASMH,DIFVIT,DIFT
00260       DOUBLE PRECISION, INTENT(INOUT) :: T1(*),T2(*),T3(*),T4(*),T5(*)
00261       DOUBLE PRECISION, INTENT(IN)    :: XNEBOR(2*NPTFR),YNEBOR(2*NPTFR)
00262       DOUBLE PRECISION, INTENT(INOUT) :: DT
00263       DOUBLE PRECISION, INTENT(IN)    :: AT,VNOIN(3,*),GAMMA
00264       DOUBLE PRECISION, INTENT(IN)    :: TSCE2(MAXSCE,MAXTRA)
00265       DOUBLE PRECISION, INTENT(INOUT) :: W(3,NPOIN),FLUSORTN,FLUENTN
00266       DOUBLE PRECISION, INTENT(IN)    :: AIRE(NPOIN),DTHAUT(NPOIN)
00267       DOUBLE PRECISION, INTENT(IN)    :: HBOR(NPTFR),UBOR(NPTFR)
00268       DOUBLE PRECISION, INTENT(IN)    :: VBOR(NPTFR),HN(NPOIN)
00269       DOUBLE PRECISION, INTENT(IN)    :: SMH(NPOIN),ZF(NPOIN),CF(NPOIN)
00270       DOUBLE PRECISION, INTENT(INOUT) :: U(NPOIN),V(NPOIN)
00271       DOUBLE PRECISION, INTENT(INOUT) :: H(NPOIN),QU(NPOIN),QV(NPOIN)
00272       DOUBLE PRECISION, INTENT(IN)    :: DPX(3,NELMAX),DPY(3,NELMAX)
00273       DOUBLE PRECISION, INTENT(INOUT) :: WINF(3,*)
00274       DOUBLE PRECISION, INTENT(IN)    :: X(NPOIN),Y(NPOIN),AIRS(NPOIN)
00275       DOUBLE PRECISION, INTENT(INOUT) :: FLUSCE(3,NPOIN)
00276       DOUBLE PRECISION, INTENT(INOUT) :: FLUX(NPOIN,3),FLUX_OLD(NPOIN,3)
00277       DOUBLE PRECISION, INTENT(INOUT) :: FLUSORT,FLUENT,MASSES
00278       DOUBLE PRECISION, INTENT(INOUT) :: FLUTENT(*),FLUTSOR(*)
00279       DOUBLE PRECISION, INTENT(INOUT) :: MASSOU(*)
00280       DOUBLE PRECISION, INTENT(IN)    :: G,CFLWTD,AIRST(2,NSEG)
00281       DOUBLE PRECISION, INTENT(INOUT) :: HSTOK(*),HCSTOK(2,*),DTT
00282       DOUBLE PRECISION, INTENT(INOUT) :: CMI(NSEG,2)
00283       DOUBLE PRECISION, INTENT(IN)    :: PROPNU,DIFNU,TMAX
00284       DOUBLE PRECISION, INTENT(INOUT) :: DJX(3,NELMAX),DJY(3,NELMAX)
00285       DOUBLE PRECISION, INTENT(INOUT) :: DX(3,NPOIN),DY(3,NPOIN)
00286       DOUBLE PRECISION, INTENT(INOUT) :: DJXT(NELMAX),DJYT(NELMAX)
00287       DOUBLE PRECISION, INTENT(INOUT) :: DXT(NPOIN),DYT(NPOIN)
00288       DOUBLE PRECISION, INTENT(INOUT) :: DSZ(2,NSEG)
00289       DOUBLE PRECISION, INTENT(INOUT) :: HC(2,NSEG),DTN
00290 !
00291       TYPE(BIEF_OBJ) , INTENT(IN)     :: TBOR,TN
00292       TYPE(BIEF_OBJ) , INTENT(INOUT)  :: T,HTN,SMTR,FLUHBOR,FLUHBTEMP
00293       TYPE(BIEF_OBJ) , INTENT(INOUT)  :: FLUXTEMP,FLUXT,FLBOR
00294       TYPE(BIEF_MESH), INTENT(INOUT)  :: MESH
00295 !
00296 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00297 !
00298       INTEGER I,IS,K,ICIN,IVIS,NORDRE,ITRAC
00299       DOUBLE PRECISION XNC,W1,DMIN,BETA,TEST
00300 !
00301       DOUBLE PRECISION P_DMIN
00302       EXTERNAL P_DMIN
00303 !
00304       DOUBLE PRECISION,PARAMETER:: EPS =  1.D-6
00305 !
00306 !
00307       IF(OPTVF.EQ.0) THEN
00308         ICIN = 0
00309         NORDRE = 1
00310       ELSEIF(OPTVF.EQ.1) THEN
00311         ICIN = 1
00312         NORDRE = 1
00313       ELSEIF(OPTVF.EQ.2) THEN
00314         ICIN = 1
00315         NORDRE = 2
00316       ELSEIF(OPTVF.EQ.3) THEN
00317         ICIN = 2
00318         NORDRE=1
00319       ELSEIF(OPTVF.EQ.4) THEN
00320         ICIN = 3
00321         NORDRE = 1
00322       ELSEIF(OPTVF.EQ.5) THEN
00323         ICIN = 4
00324         NORDRE = 1
00325       ELSEIF(OPTVF.EQ.6) THEN
00326         ICIN = 5
00327         NORDRE = 1
00328       ELSE
00329         IF(LNG.EQ.1) WRITE(LU,*) 'SCHEMA INCONNU : ',OPTVF
00330         IF(LNG.EQ.2) WRITE(LU,*) 'UNKNOWN SCHEME: ',OPTVF
00331         CALL PLANTE(1)
00332         STOP
00333       ENDIF
00334 !
00335 !  * WINF CONTAINS BC COMPUTED BY BORD
00336 !
00337 !      DO K=1,NPTFR
00338 !        IF(LIMPRO(K,1).EQ.KDIR) THEN
00339 !          WINF(1,K) =  HBOR(K)
00340 !          WINF(2,K) =  HBOR(K)*UBOR(K)
00341 !          WINF(3,K) =  HBOR(K)*VBOR(K)
00342 !        ELSE
00343 !          WINF(1,K) =  H(NBOR(K))
00344 !          WINF(2,K) =  H(NBOR(K))*UBOR(K)
00345 !          WINF(3,K) =  H(NBOR(K))*VBOR(K)
00346 !        ENDIF
00347 !       ENDDO
00348 ! ================================
00349 ! VALUES COMPUTED BY BORD ARE GOOD
00350 !=================================
00351       DO K=1,NPTFR
00352         WINF(1,K) =  H(NBOR(K))
00353         WINF(2,K) =  H(NBOR(K))*U(NBOR(K))
00354         WINF(3,K) =  H(NBOR(K))*V(NBOR(K))
00355       ENDDO
00356       IF(LT.EQ.1) THEN
00357 !       INITIALIZE QU AND QV
00358         CALL OV('X=YZ    ',QU,HN,U,1.D0,NPOIN)
00359         CALL OV('X=YZ    ',QV,HN,V,1.D0,NPOIN)
00360       ENDIF
00361 
00362       IF(ICIN .EQ.0) THEN
00363 !-----------------------------------------------------------------------
00364 !        ROE SCHEME
00365 !-----------------------------------------------------------------------
00366 !
00367         IF(LT.EQ.1) THEN
00368           WRITE(LU,*) ' '
00369           WRITE(LU,*) '          ***************** '
00370           WRITE(LU,*) '          *   ROE SCHEME  * '
00371           WRITE(LU,*) '          ***************** '
00372           WRITE(LU,*) ' '
00373 
00374 !INITIALIZATION OF FLUX_OLD
00375           DO I=1,NPOIN
00376             FLUX_OLD(I,1) = 0.0D0
00377             FLUX_OLD(I,2) = 0.0D0
00378             FLUX_OLD(I,3) = 0.0D0
00379           ENDDO
00380         ENDIF
00381 
00382 !
00383 !      COPY  VARIABLES INTO W
00384 !
00385         DO I=1,NPOIN
00386           W(1,I)= HN(I)
00387           W(2,I)= QU(I)
00388           W(3,I)= QV(I)
00389         ENDDO ! I
00390 !
00391 !CALCUL DU DT QUI SATISFAIT CFL
00392 !
00393         CALL CALDT(NPOIN,G,HN,U,V,DTHAUT,DT,AT,TMAX,
00394      &             CFLWTD,ICIN,DTVARI,LISTIN)
00395 !
00396 !      WINF CONTAINS BORDVALUE AFTER THE USE OF RIEMANN INVARIANTS
00397 !
00398         CALL FLUSEW
00399 !
00400      &     (WINF,NPOIN,EPS,G,W,XNEBOR,YNEBOR,
00401      &      NPTFR,LIMPRO,NBOR,KDIR,KDDL)
00402 !
00403 !
00404         CALL FLUROE(W,FLUSCE,NUBO,VNOIN,
00405      &              WINF,FLUX,FLUSORT,FLUENT,NELEM,NSEG,NPTFR,
00406      &              NPOIN,X,Y,AIRS,ZF,EPS,DMIN,G,
00407      &              XNEBOR,YNEBOR,LIMPRO,NBOR,KDIR,KNEU,KDDL,FLBOR,
00408      &              ELTSEG,IFABOR,MESH)
00409 !
00410 ! INTEGRATION IN TIME
00411 !
00412         CALL INTEMP(W,FLUX,FLUX_OLD,AIRS,DT,NPOIN,ZF,CF,EPS,KFROT,
00413      &             SMH,HN,QU,QV,LT,GAMMA)
00414 !
00415 ! VOLUME ADDEED BY SOURCES
00416 !
00417         IF(YASMH) THEN
00418           MASSES=0.D0
00419           DO I=1,NPOIN
00420             MASSES = MASSES + SMH(I)
00421           ENDDO
00422           MASSES = DT * MASSES
00423         ENDIF
00424 !
00425         DO  I=1,NPOIN
00426           H(I)  = W(1,I)
00427           QU(I) = W(2,I)
00428           QV(I) = W(3,I)
00429 ! SAVE FLUXES FOR NEXT TIME STEP
00430           FLUX_OLD(I,1) = FLUX(I,1)
00431           FLUX_OLD(I,2) = FLUX(I,2)
00432           FLUX_OLD(I,3) = FLUX(I,3)
00433 !
00434 !        COMPUTE U,V
00435 !
00436           IF (H(I).GT.EPS) THEN
00437             U(I)  = W(2,I) / H(I)
00438             V(I)  = W(3,I) / H(I)
00439           ELSE
00440             U(I) = 0.D0
00441             V(I) = 0.D0
00442           ENDIF
00443         ENDDO
00444 !
00445 !
00446         XNC = 0.D0
00447         DO I=1,NPOIN
00448           IF(H(I).GT.EPS) THEN
00449            W1=SQRT((QU(I)/H(I))**2+(QV(I)/H(I))**2)+SQRT(G*H(I))
00450            IF(W1.GE.XNC) XNC = W1
00451            IF(W1.GE.50.D0) THEN
00452              QU(I) = 0.D0
00453              QV(I) = 0.D0
00454            ENDIF
00455           ENDIF
00456         ENDDO
00457 !
00458       ELSE IF(ICIN.EQ.1) THEN
00459 !     ************************
00460 !
00461 !-----------------------------------------------------------------------
00462 !            KINETIC SCHEME
00463 !-----------------------------------------------------------------------
00464 !
00465         IVIS=0
00466         IF(DIFVIT.AND.ITURB.EQ.1) IVIS=1
00467 !
00468         IF(LT.EQ.1) THEN
00469 !
00470 !             INITIALIZATIONS FOR THE 1ST TIME STEP
00471 !             *************************************
00472 !
00473           WRITE(LU,*) ' '
00474           WRITE(LU,*) '          **************************'
00475           WRITE(LU,*) '          *     KINETIC SCHEME     *'
00476           IF(NORDRE.EQ.1)THEN
00477             WRITE(LU,*) '          *  FIRST ORDER IN SPACE  * '
00478           ELSE
00479             WRITE(LU,*)'          *  SECOND ORDER IN SPACE * '
00480           ENDIF
00481           WRITE(LU,*) '          **************************'
00482           WRITE(LU,*) ' '
00483 !      INITIALIZATION OF FLUX_OLD
00484           DO I=1,NPOIN
00485             FLUX_OLD(I,1) = 0.0D0
00486             FLUX_OLD(I,2) = 0.0D0
00487             FLUX_OLD(I,3) = 0.0D0
00488           ENDDO
00489 !
00490 !     COMPUTE GRADIENT OF ZF FOR ORDRE2
00491 !
00492           IF(NORDRE.EQ.2) THEN
00493             CALL GRADZ(NPOIN,NELMAX,NSEG,IKLE,NUBO,X,Y,AIRE,AIRS,CMI,
00494      &               JMI,ZF,DPX,DPY,DSZ,BETA,AIRST,T1,T2,T3,T4,T5,
00495      &               ELTSEG,IFABOR,MESH)
00496           ENDIF
00497 !
00498 !    INITIALIZATION FOR TRACER
00499 !
00500 
00501           IF(NTRAC.GT.0) THEN
00502             DO ITRAC=1,NTRAC
00503               MASSOU(ITRAC) = 0.D0
00504               FLUTENT(ITRAC)= 0.D0
00505               FLUTSOR(ITRAC)= 0.D0
00506               DO IS=1,NPOIN
00507                 HTN%ADR(ITRAC)%P%R(IS) = HN(IS) * TN%ADR(ITRAC)%P%R(IS)
00508               ENDDO
00509               CALL OS('X=Y     ',X=T%ADR(ITRAC)%P,Y=TN%ADR(ITRAC)%P)
00510             ENDDO
00511           ENDIF
00512 !
00513 !          DEFINITION OF A REFERENCE TO DISTINGUISH INTERIOR
00514 !          AND BOUNDARY NODES FOR TRACER ORDRE 2
00515 !
00516           DO IS=1,NPOIN
00517             LOGFR(IS)=0
00518           ENDDO
00519 !
00520           IF(NPTFR.GT.0)THEN !FOR PARALLLEL CASES
00521             DO K=1,NPTFR
00522               IS=NBOR(K)
00523               IF(LIMPRO(K,2).EQ.KDIR) LOGFR(IS)=1
00524               IF(LIMPRO(K,1).EQ.KDIR) LOGFR(IS)=3
00525               IF(LIMPRO(K,1).EQ.KNEU) LOGFR(IS)=2
00526             ENDDO
00527           ENDIF
00528         ENDIF
00529 !-----------------------------------------------------------------------
00530 !
00531         IF(LT.EQ.1.OR.NTRAC.EQ.0) THEN
00532 !
00533 !       REWRITE VARIABLES IN W
00534 !
00535         DO I=1,NPOIN
00536             W(1,I)= HN(I)
00537           IF (HN(I).GT.EPS) THEN
00538             W(2,I) = QU(I) / HN(I)
00539             W(3,I) = QV(I) / HN(I)
00540           ELSE
00541             W(2,I) = 0.D0
00542             W(3,I) = 0.D0
00543           ENDIF
00544         ENDDO
00545 !
00546 !  TIME STEP UNDER CFL CONDITION (ORDRE 1)
00547 !
00548         DTN = DT
00549         CALL CALDT(NPOIN,G,HN,U,V,DTHAUT,DTN,AT,TMAX,
00550      &            CFLWTD,ICIN,DTVARI,LISTIN)
00551 !
00552 ! COMPUTE HYDRAULIC FLUXES
00553 !
00554         CALL FLUHYD
00555      &        (NPOIN,NELMAX,NSEG,NPTFR,NUBO,G,DTN,X,Y,AIRS,IKLE,AIRE,
00556      &         W,ZF,VNOIN,FLUX,NBOR,LIMPRO,XNEBOR,YNEBOR,KDIR,KNEU,
00557      &         HBOR,UBOR,VBOR,FLUENTN,FLUSORTN,NORDRE,CMI,JMI,
00558      &         DJX,DJY,DX,DY,DTHAUT,CFLWTD,FLBOR,
00559      &         DPX,DPY,IVIS,PROPNU,FLUHBTEMP,BETA,DSZ,AIRST,HC,FLUXTEMP,
00560      &         NTRAC,ELTSEG,IFABOR,MESH)
00561 !
00562         IF(NTRAC.GT.0) THEN
00563 !         INITIALIZATION FOR TRACER
00564           CALL REINIT(NPOIN,NSEG,NPTFR,HN,
00565      &                SMTR,HSTOK,HC,HCSTOK,FLUXT,FLUHBOR,DTT,NTRAC)
00566         ENDIF
00567 !
00568       ENDIF
00569 !-----------------------------------------------------------------------
00570 !
00571 !                     HYDRO UPDATING
00572 !-----------------------------------------------------------------------
00573 !
00574       DT = MIN(DTN,TMAX-AT)
00575 !
00576       FLUENT =FLUENTN
00577       FLUSORT =FLUSORTN
00578       DO ITRAC=1,NTRAC
00579         FLUTENT(ITRAC)=0.D0
00580         FLUTSOR(ITRAC)=0.D0
00581         MASSOU(ITRAC) =0.D0
00582       ENDDO
00583 !
00584 ! TIME INTEGRATION
00585 !
00586       CALL MAJZZ(W,FLUX,FLUX_OLD,AIRS,DT,NPOIN,CF,KFROT,SMH,
00587      &           HN,QU,QV,LT,GAMMA,
00588      &           NPTFR,NBOR,LIMPRO,XNEBOR,YNEBOR,KNEU,G)
00589 !
00590 !-----------------------------------------------------------------------
00591 !
00592       IF(NTRAC.GT.0) THEN
00593 !
00594         DO ITRAC=1,NTRAC
00595 !
00596 !         INCREMENT OF MASS FLUX AND SOURCES FOR TRACER
00597           CALL FLUTRAC(NSEG,NPTFR,DT,FLUXT%ADR(ITRAC)%P%R,
00598      &                               FLUHBOR%ADR(ITRAC)%P%R,
00599      &                               FLUXTEMP%ADR(ITRAC)%P%R,
00600      &                               FLUHBTEMP%ADR(ITRAC)%P%R,DTT)
00601 !
00602 !        CALCULATION OF SECOND MEMBER FOR TRACER
00603           CALL SMTRAC(NPOIN,DIMT,AT,DT,SMTR%ADR(ITRAC)%P%R,
00604      &                SMH,NREJET,ISCE,TSCE2,MAXSCE,MAXTRA,ITRAC)
00605 !
00606         ENDDO
00607 !
00608       ENDIF
00609 !
00610 ! VOLUME ADDEED BY SOURCES
00611 !
00612       IF(YASMH) THEN
00613         MASSES=0.D0
00614         DO  I=1,NPOIN
00615           MASSES = MASSES + SMH(I)
00616         ENDDO
00617         MASSES = DT * MASSES
00618       ENDIF
00619 !
00620       DO I=1,NPOIN
00621         H(I)  = W(1,I)
00622         QU(I) = W(2,I)
00623         QV(I) = W(3,I)
00624 !
00625 ! SAVE FLUXES FOR NEXT TIME STEP
00626 !
00627         FLUX_OLD(I,1) = FLUX(I,1)
00628         FLUX_OLD(I,2) = FLUX(I,2)
00629         FLUX_OLD(I,3) = FLUX(I,3)
00630 !
00631 !      CALCULATION OF U,V
00632 !
00633         IF (H(I).GT.EPS) THEN
00634           U(I)  = W(2,I) / H(I)
00635           V(I)  = W(3,I) / H(I)
00636         ELSE
00637           U(I) = 0.D0
00638           V(I) = 0.D0
00639         ENDIF
00640       ENDDO ! I
00641 !
00642       IF(NTRAC.EQ.0)  RETURN
00643 !
00644 !-----------------------------------------------------------------------
00645 ! IF END OF COMPUTATION, WE UPDATE TRACER
00646 !
00647       IF(AT+DT.GE.TMAX) GOTO 200
00648 !
00649 !-----------------------------------------------------------------------
00650 !    IF TRACER, WE ANTICIPATE THE COMPUTATION OF FLUXES
00651 !-----------------------------------------------------------------------
00652 !
00653 ! WE PUT PRIMITIVE VARIABLES  IN W
00654 !
00655       DO I=1,NPOIN
00656         W(1,I) = H(I)
00657         W(2,I) = U(I)
00658         W(3,I) = V(I)
00659       ENDDO
00660 !
00661 ! TIME STEP UNDER CFL CONDITION (ORDRE 1)
00662 !
00663 !  we may use H and not HN for DT computing !!!!  to be verified
00664 !
00665       CALL CALDT(NPOIN,G,HN,U,V,DTHAUT,DTN,AT,TMAX,
00666      &           CFLWTD,ICIN,DTVARI,LISTIN)
00667 !
00668 ! HYDRO FLUXES OF THE NEXT TIME STEP
00669 !
00670       CALL FLUHYD
00671      &       (NPOIN,NELMAX,NSEG,NPTFR,NUBO,G,DTN,X,Y,AIRS,IKLE,AIRE,
00672      &        W,ZF,VNOIN,FLUX,NBOR,LIMPRO,XNEBOR,YNEBOR,KDIR,KNEU,
00673      &        HBOR,UBOR,VBOR,FLUENTN,FLUSORTN,NORDRE,CMI,JMI,
00674      &        DJX,DJY,DX,DY,DTHAUT,CFLWTD,FLBOR,
00675      &        DPX,DPY,IVIS,PROPNU,FLUHBTEMP,BETA,
00676      &        DSZ,AIRST,HC,FLUXTEMP,NTRAC,ELTSEG,IFABOR,MESH)
00677 !
00678 ! TEST OF TRACER FLUX (FOR POSITIVITY)
00679 !
00680 !    USELESS, BUT TO AVOID COMPILER ERROR
00681       TEST=-1.D0
00682 !
00683       CALL TESTEUR(NPOIN,NSEG,NPTFR,NUBO,DTN,NBOR,
00684      &             NORDRE,AIRS,AIRST,HSTOK,HCSTOK,
00685      &             FLUXT,FLUXTEMP,FLUHBOR,FLUHBTEMP,LOGFR,TEST,NTRAC)
00686 !
00687 !  IF THERE IS NEGATIVE TEST ALL PROC WILL CONTINUE
00688       TEST = P_DMIN(TEST)
00689       IF(TEST.GE.0.D0) RETURN
00690  200  CONTINUE
00691 !
00692 !TRACER UPDATING
00693 !
00694       LTT=LTT+1
00695 !
00696       DO ITRAC=1,NTRAC
00697 !
00698       CALL MAJTRAC(NPOIN,NELMAX,DIMT,DLIMT,NSEG,NPTFR,NUBO,
00699      &             X,Y,AIRS,IKLE,AIRE,T%ADR(ITRAC)%P%R,
00700      &             HTN%ADR(ITRAC)%P%R,TN%ADR(ITRAC)%P%R,ZF,NBOR,
00701      &             TBOR%ADR(ITRAC)%P%R,FLUTENT(ITRAC),FLUTSOR(ITRAC),
00702      &             SMTR%ADR(ITRAC)%P%R,NORDRE,CMI,JMI,
00703      &             DJXT,DJYT,DXT,DYT,
00704      &             DPX,DPY,DIFT,DIFNU,BETA,DSZ,AIRST,HSTOK,
00705      &             HCSTOK,FLUXT%ADR(ITRAC)%P%R,FLUHBOR%ADR(ITRAC)%P%R,
00706      &             MASSOU(ITRAC),DTT,MESH,ELTSEG,IFABOR,VNOIN)
00707 !
00708 !
00709       DO I=1,NPOIN
00710         HTN%ADR(ITRAC)%P%R(I) = T%ADR(ITRAC)%P%R(I)
00711         IF(H(I).GT.EPS) THEN
00712           T%ADR(ITRAC)%P%R(I) = T%ADR(ITRAC)%P%R(I) / H(I)
00713         ELSE
00714           T%ADR(ITRAC)%P%R(I) = 0.D0
00715         ENDIF
00716       ENDDO
00717 !
00718       ENDDO
00719 !
00720 ! INITIALIZATION FOR TRACER
00721 !
00722       CALL REINIT(NPOIN,NSEG,NPTFR,H,
00723      &            SMTR,HSTOK,HC,HCSTOK,FLUXT,FLUHBOR,DTT,NTRAC)
00724 !
00725       ELSE IF(ICIN.EQ.2) THEN
00726 !   *****************************
00727 !
00728 !-----------------------------------------------------------------------
00729 !            ZOKAGOA SCHEME
00730 !-----------------------------------------------------------------------
00731 !
00732 !
00733       IF(LT.EQ.1) THEN
00734 !
00735 !            INITIALIZATIONS FOR THE FIRST TIME STEP
00736 !            ***********************************
00737 !
00738         WRITE(LU,*) ' '
00739         WRITE(LU,*) '          *********************** '
00740         WRITE(LU,*) '          *   ZOKAGOA SCHEME    * '
00741         WRITE(LU,*) '          *********************** '
00742         WRITE(LU,*) ' '
00743 !INITIALIZATION OF FLUX_OLD
00744         DO I=1,NPOIN
00745           FLUX_OLD(I,1) = 0.0D0
00746           FLUX_OLD(I,2) = 0.0D0
00747           FLUX_OLD(I,3) = 0.0D0
00748         ENDDO
00749 
00750       ENDIF
00751 
00752 !-----------------------------------------------------------------------
00753 !
00754 !    COPY VARIABLES INTO W
00755 !
00756       DO I=1,NPOIN
00757         W(1,I)= HN(I)
00758         W(2,I)= QU(I)
00759         W(3,I)= QV(I)
00760       ENDDO
00761 !
00762 ! TIME STEP UNDER CFL CONDITION
00763 !
00764       CALL CALDT(NPOIN,G,HN,U,V,DTHAUT,DT,AT,TMAX,
00765      &           CFLWTD,ICIN,DTVARI,LISTIN)
00766 !
00767 !INFLOW AND OUTFLOWS
00768 !
00769       CALL FLUSEW(WINF,NPOIN,EPS,G,W,XNEBOR,YNEBOR,
00770      &            NPTFR,LIMPRO,NBOR,KDIR,KDDL)
00771 !
00772 !-----------------------------------------------------------------------
00773 ! FLUX COMPUTATION
00774       CALL FLUXZZ(X,Y,NPOIN,NSEG,NELMAX,NUBO,G,W,ZF,VNOIN,
00775      &            ELTSEG,FLUX,IFABOR)
00776 ! FOR PARALLESM
00777       IF(NCSIZE.GT.1)THEN
00778         CALL PARCOM2(FLUX(:,1),FLUX(:,2),FLUX(:,3),NPOIN,1,2,3,MESH)
00779       ENDIF
00780 !BOUNDARY CONDITIONS
00781       CALL CDLZZ(NPOIN,NPTFR,NBOR,LIMPRO,XNEBOR,YNEBOR,KDIR,KNEU,
00782      &           KDDL,G,W,FLUX,FLUENT,FLUSORT,
00783      &           FLBOR,ZF,WINF)
00784 !
00785 !-----------------------------------------------------------------------
00786 !
00787 ! TIME INTEGRATION
00788 !
00789       CALL MAJZZ(W,FLUX,FLUX_OLD,AIRS,DT,NPOIN,CF,KFROT,SMH,
00790      &          HN,QU,QV,LT,GAMMA,
00791      &          NPTFR,NBOR,LIMPRO,XNEBOR,YNEBOR,KNEU,G)
00792 !-----------------------------------------------------------------------
00793 
00794 ! VOLUME ADDED BY SOURCE TERMS
00795 !
00796       IF(YASMH) THEN
00797         MASSES=0.D0
00798       DO  I=1,NPOIN
00799         MASSES = MASSES + SMH(I)
00800       ENDDO
00801         MASSES = DT * MASSES
00802       ENDIF
00803 !
00804       DO I=1,NPOIN
00805         H(I)  = W(1,I)
00806         QU(I) = W(2,I)
00807         QV(I) = W(3,I)
00808 ! SAVE FLUXES FOR NEXT TIME STEP
00809         FLUX_OLD(I,1) = FLUX(I,1)
00810         FLUX_OLD(I,2) = FLUX(I,2)
00811         FLUX_OLD(I,3) = FLUX(I,3)
00812 !
00813 !      COMPUTE  U,V
00814 !
00815         IF (H(I).GT.EPS) THEN
00816           U(I)  = W(2,I) / H(I)
00817           V(I)  = W(3,I) / H(I)
00818         ELSE
00819           U(I) = 0.D0
00820           V(I) = 0.D0
00821         ENDIF
00822       ENDDO !  I
00823 !
00824 !-----------------------------------------------------------------------
00825 !
00826 !
00827       ELSE IF(ICIN.EQ.3) THEN
00828 !     ***********************
00829 !
00830 !-----------------------------------------------------------------------
00831 !             TCHAMEN SCHEME
00832 !-----------------------------------------------------------------------
00833 !
00834 !
00835       IF(LT.EQ.1) THEN
00836 !
00837 !            INITIALIZATIONS FOR THE 1ST TIME STEP
00838 !            ***********************************
00839 !
00840         WRITE(LU,*) ' '
00841         WRITE(LU,*) '          *********************** '
00842         WRITE(LU,*) '          *   TCHAMEN SCHEME    * '
00843         WRITE(LU,*) '          *********************** '
00844         WRITE(LU,*) ' '
00845 !INITIALIZATION OF FLUX_OLD
00846         DO I=1,NPOIN
00847           FLUX_OLD(I,1) = 0.0D0
00848           FLUX_OLD(I,2) = 0.0D0
00849           FLUX_OLD(I,3) = 0.0D0
00850         ENDDO
00851 
00852       ENDIF
00853 
00854 !-----------------------------------------------------------------------
00855 !
00856 !   CPY VARIABLES INTO W
00857 !
00858       DO I=1,NPOIN
00859         W(1,I)= HN(I)
00860         W(2,I)= QU(I)
00861         W(3,I)= QV(I)
00862       ENDDO
00863 !
00864 ! TIME STEP UNDER CFL CONDITION
00865 !
00866       CALL CALDT(NPOIN,G,HN,U,V,DTHAUT,DT,AT,TMAX,
00867      &           CFLWTD,ICIN,DTVARI,LISTIN)
00868 !
00869 !
00870 !INFLOW AND OUTFLOWS ! USELESS
00871 !
00872 !      CALL FLUSEW(WINF,NPOIN,EPS,G,W,XNEBOR,YNEBOR,
00873 !     &            NPTFR,LIMPRO,NBOR,KDIR,KDDL)
00874 !
00875 !-----------------------------------------------------------------------
00876 ! FLUX COMPUTATION
00877 
00878       CALL FLUX_TCH(X,Y,NPOIN,NSEG,NELMAX,NUBO,G,W,ZF,VNOIN,
00879      &              ELTSEG,FLUX,IFABOR)
00880 
00881 !  FOR PARALLESM
00882       IF(NCSIZE.GT.1)THEN
00883         CALL PARCOM2(FLUX(:,1),FLUX(:,2),FLUX(:,3),NPOIN,1,2,3,MESH)
00884       ENDIF
00885 !BOUNDARY CONDITIONS
00886         CALL CDL_TCH(NPOIN,NPTFR,NBOR,LIMPRO,XNEBOR,YNEBOR,KDIR,KNEU,
00887      &               KDDL,G,W,FLUX,FLUENT,FLUSORT,
00888      &               FLBOR,EPS,ZF,WINF)
00889 !
00890 !-----------------------------------------------------------------------
00891 !
00892 ! TIME INTEGRATION
00893 !
00894       CALL MAJZZ(W,FLUX,FLUX_OLD,AIRS,DT,NPOIN,CF,KFROT,SMH,
00895      &           HN,QU,QV,LT,GAMMA,
00896      &           NPTFR,NBOR,LIMPRO,XNEBOR,YNEBOR,KNEU,G)
00897 !
00898 !
00899 !-----------------------------------------------------------------------
00900 !
00901 !VOLUME ADDED BY SOURCES
00902 !
00903       IF(YASMH) THEN
00904         MASSES=0.D0
00905       DO  I=1,NPOIN
00906         MASSES = MASSES + SMH(I)
00907       ENDDO
00908         MASSES = DT * MASSES
00909       ENDIF
00910 !
00911       DO I=1,NPOIN
00912         H(I)  = W(1,I)
00913         QU(I) = W(2,I)
00914         QV(I) = W(3,I)
00915 ! SAVE FLUXES FOR NEXT TIME STEP
00916         FLUX_OLD(I,1) = FLUX(I,1)
00917         FLUX_OLD(I,2) = FLUX(I,2)
00918         FLUX_OLD(I,3) = FLUX(I,3)
00919 !
00920 !      COMPUTATION U,V
00921 !
00922         IF (H(I).GT.EPS) THEN
00923           U(I)  = W(2,I) / H(I)
00924           V(I)  = W(3,I) / H(I)
00925         ELSE
00926           U(I) = 0.D0
00927           V(I) = 0.D0
00928         ENDIF
00929       ENDDO !    I
00930 !
00931 !    *****************************
00932       ELSE IF(ICIN.EQ.4) THEN
00933 !    *****************************
00934 !-----------------------------------------------------------------------
00935 !             HLLC SCHEME
00936 !-----------------------------------------------------------------------
00937 !
00938 !
00939       IF(LT.EQ.1) THEN
00940 !
00941 !             INITIALIZATION FOR THE 1ST TIME STEP
00942 !             *************************************
00943 !
00944         WRITE(LU,*) ' '
00945         WRITE(LU,*) '          *********************** '
00946         WRITE(LU,*) '          *     HLLC  SCHEME    * '
00947         WRITE(LU,*) '          *********************** '
00948         WRITE(LU,*) ' '
00949 ! INITIALIZATION OF FLUX_OLD
00950         DO I=1,NPOIN
00951           FLUX_OLD(I,1) = 0.0D0
00952           FLUX_OLD(I,2) = 0.0D0
00953           FLUX_OLD(I,3) = 0.0D0
00954         ENDDO
00955 
00956       ENDIF
00957 
00958 !-----------------------------------------------------------------------
00959 !     COPY VARIABLES INTO W
00960 !
00961       DO I=1,NPOIN
00962         W(1,I)= HN(I)
00963         W(2,I)= QU(I)
00964         W(3,I)= QV(I)
00965       ENDDO
00966 !
00967 !  TIME STEP UNDER CFL CONDITION
00968 !
00969       CALL CALDT(NPOIN,G,HN,U,V,DTHAUT,DT,AT,TMAX,
00970      &           CFLWTD,ICIN,DTVARI,LISTIN)
00971 !
00972 !
00973 ! INFLOW AND OUTFLOWS
00974 !
00975 !      CALL FLUSEW(WINF,NPOIN,EPS,G,W,XNEBOR,YNEBOR,
00976 !     &            NPTFR,LIMPRO,NBOR,KDIR,KDDL)
00977 !
00978 !-----------------------------------------------------------------------
00979 !  FLUX COMPUTATION
00980 !
00981       CALL HYD_HLLC(NPOIN,NELEM,NSEG,NUBO,G,W,ZF,VNOIN,
00982      &              X,Y,ELTSEG,FLUX,IFABOR)
00983 !  FOR PARALLESM
00984       IF(NCSIZE.GT.1)THEN
00985         CALL PARCOM2(FLUX(1,1),FLUX(1,2),FLUX(1,3),NPOIN,1,2,3,MESH)
00986       ENDIF
00987 !
00988 ! BOUNDARY CONDITIONS
00989 !
00990       CALL CDL_HLLC(NPOIN,NPTFR,NBOR,LIMPRO,XNEBOR,YNEBOR,
00991      &              W,FLUX,FLUENT,FLUSORT,FLBOR,EPS,WINF,
00992      &              G,HBOR,UBOR,VBOR)
00993 !
00994 !     ASSEMBLY IN PARALLEL (EVEN IF NPTFR=0)
00995 !
00996       IF(NCSIZE.GT.1) THEN
00997         CALL PARCOM_BORD(FLUX(:,1),2,MESH)
00998         CALL PARCOM_BORD(FLUX(:,2),2,MESH)
00999         CALL PARCOM_BORD(FLUX(:,3),2,MESH)
01000       ENDIF
01001 !
01002 !-----------------------------------------------------------------------
01003 !
01004 !  TIME INTEGRATION
01005 !
01006       CALL MAJZZ(W,FLUX,FLUX_OLD,AIRS,DT,NPOIN,CF,KFROT,SMH,
01007      &           HN,QU,QV,LT,GAMMA,
01008      &           NPTFR,NBOR,LIMPRO,XNEBOR,YNEBOR,KNEU,G)
01009 !
01010 !
01011 !-----------------------------------------------------------------------
01012 !
01013 !  COMPUTES VOLUME ADDED BY SOURCES
01014 !
01015       IF(YASMH) THEN
01016         MASSES=0.D0
01017       DO  I=1,NPOIN
01018         MASSES = MASSES + SMH(I)
01019       ENDDO
01020         MASSES = DT * MASSES
01021       ENDIF
01022 !
01023       DO I=1,NPOIN
01024         H(I)  = W(1,I)
01025         QU(I) = W(2,I)
01026         QV(I) = W(3,I)
01027 !  SAVE FLUXES FOR NEXT TIME STEP
01028         FLUX_OLD(I,1) = FLUX(I,1)
01029         FLUX_OLD(I,2) = FLUX(I,2)
01030         FLUX_OLD(I,3) = FLUX(I,3)
01031 !
01032 !       CALCUL DE U,V
01033 !
01034         IF (H(I).GT.EPS) THEN
01035           U(I)  = W(2,I) / H(I)
01036           V(I)  = W(3,I) / H(I)
01037         ELSE
01038           U(I) = 0.D0
01039           V(I) = 0.D0
01040         ENDIF
01041 !
01042       ENDDO ! I
01043 !
01044 !    *****************************
01045       ELSEIF(ICIN.EQ.5) THEN
01046 !    *****************************
01047 !-----------------------------------------------------------------------
01048 !             WAF SCHEME
01049 !-----------------------------------------------------------------------
01050 !
01051 !
01052       IF(LT.EQ.1) THEN
01053 !
01054 !             INITIALIZATION FOR THE 1ST TIME STEP
01055 !             *************************************
01056 !
01057         WRITE(LU,*) ' '
01058         WRITE(LU,*) '          *********************** '
01059         WRITE(LU,*) '          *     WAF  SCHEME    * '
01060         WRITE(LU,*) '          *********************** '
01061         WRITE(LU,*) ' '
01062 ! INITIALIZATION OF FLUX_OLD
01063         DO I=1,NPOIN
01064           FLUX_OLD(I,1) = 0.0D0
01065           FLUX_OLD(I,2) = 0.0D0
01066           FLUX_OLD(I,3) = 0.0D0
01067         ENDDO
01068 ! INITIALIZATION OF NEISEG
01069         DO I=1,NSEG
01070           NEISEG(1,I) = 0
01071           NEISEG(2,I) = 0
01072         ENDDO
01073 ! SEARCH FOR NEIGHBORS OF SEGMENT (FOR LIMITER)
01074 !       CALL SEG_NEIGHBORS
01075 !    &       (X,Y,NPOIN,NVMAX,NELEM,NSEG,
01076 !    &        ELTSEG,NUBO,IFABOR,KNOLG,NEISEG)
01077         CALL SEG_NEIGHBORS
01078      &      (X,Y,IKLE,NPOIN,NVMAX,NELEM,NELMAX,NSEG,NEISEG)
01079       ENDIF
01080 !-----------------------------------------------------------------------
01081 !     COPY VARIABLES INTO W
01082 !
01083       DO I=1,NPOIN
01084         W(1,I)= HN(I)
01085         W(2,I)= QU(I)
01086         W(3,I)= QV(I)
01087       ENDDO
01088 !
01089 !  TIME STEP UNDER CFL CONDITION
01090 !
01091       CALL CALDT(NPOIN,G,HN,U,V,DTHAUT,DT,AT,TMAX,
01092      &           CFLWTD,ICIN,DTVARI,LISTIN)
01093 !
01094 !
01095 ! INFLOW AND OUTFLOWS
01096 !
01097       CALL FLUSEW
01098      &   (WINF,NPOIN,EPS,G,W,XNEBOR,YNEBOR,
01099      &    NPTFR,LIMPRO,NBOR,KDIR,KDDL)
01100 !
01101 !-----------------------------------------------------------------------
01102 !  FLUX COMPUTATION
01103       CALL HYD_WAF
01104      &   (NPOIN,NSEG,NELEM,NUBO,G,W,ZF,VNOIN,DT,DTHAUT,
01105      &    X,Y,FLUX,ELTSEG,NEISEG)
01106 !
01107 ! BOUNDARY CONDITIONS
01108 !
01109       CALL CDL_WAF(NPOIN,NPTFR,NBOR,LIMPRO,XNEBOR,YNEBOR,KDIR,KNEU,
01110      &             KDDL,W,FLUX,FLUENT,FLUSORT,FLBOR,DTHAUT,DT,
01111      &             EPS,WINF)
01112 !
01113 !-----------------------------------------------------------------------
01114 !
01115 !  TIME INTEGRATION
01116 !
01117       CALL MAJZZ(W,FLUX,FLUX_OLD,AIRS,DT,NPOIN,CF,KFROT,SMH,
01118      &           HN,QU,QV,LT,GAMMA,
01119      &           NPTFR,NBOR,LIMPRO,XNEBOR,YNEBOR,KNEU,G)
01120 !
01121 !-----------------------------------------------------------------------
01122 !
01123 !  COMPUTES VOLUME ADDED BY SOURCES
01124 !
01125       IF(YASMH) THEN
01126         MASSES=0.D0
01127       DO  I=1,NPOIN
01128         MASSES = MASSES + SMH(I)
01129       ENDDO
01130         MASSES = DT * MASSES
01131       ENDIF
01132 !
01133       DO I=1,NPOIN
01134         H(I)  = W(1,I)
01135         QU(I) = W(2,I)
01136         QV(I) = W(3,I)
01137 !  SAVE FLUXES FOR NEXT TIME STEP
01138         FLUX_OLD(I,1) = FLUX(I,1)
01139         FLUX_OLD(I,2) = FLUX(I,2)
01140         FLUX_OLD(I,3) = FLUX(I,3)
01141 !
01142 !       COMPUTE U AND V
01143 !
01144         IF (H(I).GT.EPS) THEN
01145           U(I)  = W(2,I) / H(I)
01146           V(I)  = W(3,I) / H(I)
01147         ELSE
01148           U(I) = 0.D0
01149           V(I) = 0.D0
01150         ENDIF
01151       ENDDO ! I
01152 !
01153 !-----------------------------------------------------------------------
01154 !
01155       ENDIF
01156 !
01157       RETURN
01158       END

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