bilant1.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\bilant1.f
00002 !
00061                      SUBROUTINE BILANT1
00062 !                    ******************
00063 !
00064      &(H,UCONV,VCONV,HPROP,WORK1,WORK2,WORK3,WORK4,WORK5,DT,LT,NIT,INFO,
00065      & MASKTR,T,TN,TETAT,MASSOU,MSK,MASKEL,MESH,FLUSOR,FLUENT,EQUA,LTT,
00066      & ITRAC)
00067 !
00068 !***********************************************************************
00069 ! TELEMAC2D   V6P1                                   21/08/2010
00070 !***********************************************************************
00071 !
00072 !
00073 !
00074 !
00075 !
00076 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00077 !| DT             |-->| TIME STEP IN SECONDS
00078 !| EQUA           |-->| STRING DESCRIBING THE EQUATIONS SOLVED
00079 !| FLUENT         |-->| ENTERING FLUX
00080 !| FLUSOR         |-->| EXITING FLUX
00081 !| H              |-->| DEPTH AT TIME N+1.
00082 !| HPROP          |-->| PROPAGATION DEPTH.
00083 !| INFO           |-->| IF YES, PRINTING INFORMATIONS
00084 !| ITRAC          |-->| TRACER INDEX
00085 !| LT             |-->| TIME STEP NUMBER
00086 !| LTT            |-->| NOT USED !!!!!!!!!!!!!!
00087 !| MASKEL         |-->| MASKING OF ELEMENTS
00088 !|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
00089 !| MASKTR         |-->| MASKING OF TRACERS, PER POINT.
00090 !|                |   | =1. : NORMAL   =0. : MASKED
00091 !| MASSOU         |-->| MASS OF TRACER ADDED BY SOURCE TERM
00092 !|                |   | SEE DIFSOU
00093 !| MESH           |-->| MESH STRUCTURE
00094 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00095 !| NIT            |-->| TOTAL NUMBER OF TIME STEPS
00096 !| T              |-->| TRACER AT TIME T(N+1)
00097 !| TETAT          |-->| SEMI-IMPLICITATION DU TRACEUR.
00098 !| TN             |-->| TRACER AT TIME T(N)
00099 !| UCONV          |-->| X-COMPONENT OF ADVECTION FIELD
00100 !| VCONV          |-->| Y-COMPONENT OF ADVECTION FIELD
00101 !| WORK1          |<->| WORK ARRAY IN A BIEF_OBJ STRUCTURE
00102 !| WORK2          |<->| WORK ARRAY IN A BIEF_OBJ STRUCTURE
00103 !| WORK3          |<->| WORK ARRAY IN A BIEF_OBJ STRUCTURE
00104 !| WORK4          |<->| WORK ARRAY IN A BIEF_OBJ STRUCTURE
00105 !| WORK5          |<->| WORK ARRAY IN A BIEF_OBJ STRUCTURE
00106 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00107 !
00108       USE BIEF
00109 !
00110       IMPLICIT NONE
00111       INTEGER LNG,LU
00112       COMMON/INFO/LNG,LU
00113 !
00114 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00115 !
00116       INTEGER, INTENT(IN)            :: LT,NIT,LTT,ITRAC
00117       DOUBLE PRECISION, INTENT(IN)   :: DT,TETAT,MASSOU,FLUSOR,FLUENT
00118       TYPE(BIEF_OBJ), INTENT(INOUT)  :: WORK1,WORK2,WORK3,WORK4,WORK5
00119       TYPE(BIEF_OBJ), INTENT(IN)     :: HPROP,UCONV,VCONV,H,T,TN,MASKEL
00120       TYPE(BIEF_OBJ), INTENT(IN)     :: MASKTR
00121       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00122       LOGICAL, INTENT(IN)            :: MSK,INFO
00123       CHARACTER(LEN=20), INTENT(IN)  :: EQUA
00124 !
00125 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00126 !
00127       DOUBLE PRECISION P_DSUM
00128       EXTERNAL         P_DSUM
00129 !
00130       INTEGER DIR,DDL,OND,IELMT,IELMH
00131 !
00132       DOUBLE PRECISION PERDUE
00133       DOUBLE PRECISION FLUXT,MASBOR
00134       DOUBLE PRECISION FLTDIR,FLTDDL,FLTOND
00135       DOUBLE PRECISION C,RELATI,DENOM
00136 !
00137       DOUBLE PRECISION MASTR0(100),MASTR1(100),MASTR2(100),MASTEN(100)
00138       DOUBLE PRECISION MASTOU(100),DIRTOT(100)
00139 !
00140       INTRINSIC ABS,MAX
00141 !
00142 !-----------------------------------------------------------------------
00143 !
00144       SAVE MASTR0,MASTR1,MASTR2,MASTEN,MASTOU,DIRTOT
00145 !
00146 !-----------------------------------------------------------------------
00147 !
00148       IELMT = T%ELM
00149       IELMH = H%ELM
00150 !
00151 !-----------------------------------------------------------------------
00152 !
00153 ! PROVISIONAL: H AND HPROP ARE REPLACED BY WORK4 AND WORK5 EVERYWHERE
00154 !
00155       CALL OS ('X=Y     ' , WORK4 , H     , H , C )
00156       CALL OS ('X=Y     ' , WORK5 , HPROP , H , C )
00157 !
00158       IF(IELMT.NE.IELMH) THEN
00159         CALL CHGDIS(WORK4,IELMH,IELMT,MESH)
00160         CALL CHGDIS(WORK5,IELMH,IELMT,MESH)
00161       ENDIF
00162 !
00163 ! END OF PROVISIONAL, EXCEPT FOR REPLACEMENT OF H AND HPROP BELOW
00164 !
00165 !-----------------------------------------------------------------------
00166 !
00167 !  COMPATIBLE CALCULATION OF THE QUANTITY OF TRACER:
00168 !
00169       IF(LT.NE.0) MASTR1(ITRAC) = MASTR2(ITRAC)
00170 !     H IS PUT HERE AS A DUMMY STRUCTURE
00171 !
00172       IF(EQUA(1:15).EQ.'SAINT-VENANT VF') THEN
00173         CALL VECTOR(WORK2,'=','MASBAS          ',IELMT,
00174      &              1.D0,H,H,H,H,H,H,MESH,MSK,MASKEL)
00175         CALL OS( 'X=XY    ' , WORK2 , T , H , C )
00176       ELSE
00177         CALL VECTOR(WORK2,'=','MASVEC          ',IELMT,
00178      &              1.D0,T,H,H,H,H,H,MESH,MSK,MASKEL)
00179       ENDIF
00180       MASTR2(ITRAC) = DOTS(WORK2,WORK4)
00181       IF(NCSIZE.GT.1) MASTR2(ITRAC)=P_DSUM(MASTR2(ITRAC))
00182 !
00183       IF(LT.EQ.0) THEN
00184         MASTR0(ITRAC) = MASTR2(ITRAC)
00185         MASTR1(ITRAC) = MASTR2(ITRAC)
00186         MASTEN(ITRAC) = 0.D0
00187         MASTOU(ITRAC) = 0.D0
00188         DIRTOT(ITRAC) = 0.D0
00189       ENDIF
00190 !
00191 !=======================================================================
00192 !
00193 !   CALCULATES FLUXES (IT MISSES DIFFUSIVE FLUX,...TO BE LOOKED AT)
00194 !
00195 !=======================================================================
00196 !
00197       DIR=1
00198       DDL=2
00199       OND=4
00200 !
00201 !=======================================================================
00202 !   CALCULATES IMPOSED FLUXES (DISCHARGE IMPOSED OR VELOCITY IMPOSED)
00203 !
00204       IF(EQUA(1:15).EQ.'SAINT-VENANT VF') THEN
00205         FLTDIR = FLUENT
00206       ELSE
00207         CALL VECTOR(WORK2,'=','FLUBDF          ',IELBOR(IELMT,1),
00208      &              1.D0,WORK5,H,H,UCONV,VCONV,VCONV,
00209      &              MESH,.TRUE.,MASKTR%ADR(DIR)%P)
00210 !
00211         CALL CPSTVC(WORK2,WORK3)
00212         CALL OSBD( 'X=CY    ' , WORK3 , T  ,  T , TETAT      , MESH )
00213         CALL OSBD( 'X=X+CY  ' , WORK3 , TN ,  T , 1.D0-TETAT , MESH )
00214         FLTDIR=DOTS(WORK2,WORK3)
00215         IF(NCSIZE.GT.1) FLTDIR=P_DSUM(FLTDIR)
00216       ENDIF
00217 !
00218 !=======================================================================
00219 !
00220 !   CALCULATES FREE FLUXES
00221 !
00222       IF(EQUA(1:15).EQ.'SAINT-VENANT VF') THEN
00223         FLTDDL = FLUSOR
00224       ELSE
00225         CALL VECTOR(WORK2,'=','FLUBDF          ',IELBOR(IELMT,1),
00226      &              1.D0,WORK5,H,H,UCONV,VCONV,VCONV,
00227      &              MESH,.TRUE.,MASKTR%ADR(DDL)%P)
00228         CALL CPSTVC(WORK2,WORK3)
00229         CALL OSBD( 'X=CY    ' , WORK3 , T  ,  T , TETAT      , MESH )
00230         CALL OSBD( 'X=X+CY  ' , WORK3 , TN ,  T , 1.D0-TETAT , MESH )
00231         FLTDDL=DOTS(WORK2,WORK3)
00232         IF(NCSIZE.GT.1) FLTDDL=P_DSUM(FLTDDL)
00233       ENDIF
00234 !
00235 !=======================================================================
00236 !
00237 !   CALCULATES FLUXES BY INCIDENTAL WAVE
00238 !
00239       CALL VECTOR(WORK2,'=','FLUBDF          ',IELBOR(IELMT,1),
00240      &            1.D0,WORK5,H,H,UCONV,VCONV,VCONV,
00241      &            MESH,.TRUE.,MASKTR%ADR(OND)%P)
00242       CALL CPSTVC(WORK2,WORK3)
00243       CALL OSBD( 'X=CY    ' , WORK3 , T  ,  T , TETAT      , MESH )
00244       CALL OSBD( 'X=X+CY  ' , WORK3 , TN ,  T , 1.D0-TETAT , MESH )
00245       FLTOND=DOTS(WORK2,WORK3)
00246       IF(NCSIZE.GT.1) FLTOND=P_DSUM(FLTOND)
00247 !
00248 !=======================================================================
00249 !
00250 !   CALCULATES FLUXES AT THE LIQUID BOUNDARIES
00251 !
00252       FLUXT = FLTDIR + FLTDDL + FLTOND
00253       MASTEN(ITRAC) = MASTEN(ITRAC) - FLUXT
00254       MASTOU(ITRAC) = MASTOU(ITRAC) + MASSOU
00255       DIRTOT(ITRAC) = DIRTOT(ITRAC) - FLTDIR
00256 !
00257 !=======================================================================
00258 !
00259 !   CALCULATES THE FLUX OF TRACER THROUGH THE WALLS, BY LAW OF FLUX
00260 !
00261 !     PROVISIONAL, TO BE PROGRAMMED
00262       MASBOR = 0.D0
00263 !
00264 !=======================================================================
00265 !
00266 !  PRINTS:
00267 !
00268       IF(INFO) THEN
00269 !
00270 !-----------------------------------------------------------------------
00271 !
00272 !     PRINTS FOR THE TRACER
00273 !
00274         IF(LNG.EQ.1) WRITE(LU,500) ITRAC
00275         IF(LNG.EQ.2) WRITE(LU,501) ITRAC
00276 !
00277         IF(LT.EQ.0) THEN
00278 !
00279           IF(LNG.EQ.1) WRITE(LU,1090) MASTR0(ITRAC)
00280           IF(LNG.EQ.2) WRITE(LU,2090) MASTR0(ITRAC)
00281 !
00282         ELSE
00283 !
00284           IF(LNG.EQ.1) THEN
00285             WRITE(LU,1100) MASTR2(ITRAC)
00286             IF(ABS(FLTDIR).GT.1.D-8) WRITE(LU,1110) -FLTDIR
00287             IF(ABS(FLTDDL).GT.1.D-8) WRITE(LU,1111) -FLTDDL
00288             IF(ABS(FLTOND).GT.1.D-8) WRITE(LU,1112) -FLTOND
00289             IF(ABS(MASSOU).GT.1.D-8) WRITE(LU,1113) MASSOU
00290           ENDIF
00291           IF(LNG.EQ.2) THEN
00292             WRITE(LU,2100) MASTR2(ITRAC)
00293             IF(ABS(FLTDIR).GT.1.D-8) WRITE(LU,2110) -FLTDIR
00294             IF(ABS(FLTDDL).GT.1.D-8) WRITE(LU,2111) -FLTDDL
00295             IF(ABS(FLTOND).GT.1.D-8) WRITE(LU,2112) -FLTOND
00296             IF(ABS(MASSOU).GT.1.D-8) WRITE(LU,2113) MASSOU
00297           ENDIF
00298 !
00299           PERDUE = MASTR0(ITRAC)+MASTEN(ITRAC)+
00300      &             MASBOR+MASTOU(ITRAC)-MASTR2(ITRAC)
00301           DENOM = MAX(MASTR0(ITRAC),MASTR2(ITRAC),ABS(DIRTOT(ITRAC)))
00302           IF(DENOM.GT.1.D-8) THEN
00303             RELATI = PERDUE / DENOM
00304             IF(LNG.EQ.1) WRITE(LU,1140) RELATI
00305             IF(LNG.EQ.2) WRITE(LU,2140) RELATI
00306           ELSE
00307             RELATI = PERDUE
00308             IF(LNG.EQ.1) WRITE(LU,1150) RELATI
00309             IF(LNG.EQ.2) WRITE(LU,2150) RELATI
00310           ENDIF
00311 !
00312           IF(LNG.EQ.1) THEN
00313             IF(ABS(MASTEN(ITRAC)).GT.1.D-8) WRITE(LU,1161) MASTEN(ITRAC)
00314             IF(ABS(MASTOU(ITRAC)).GT.1.D-8) WRITE(LU,1164) MASTOU(ITRAC)
00315           ENDIF
00316           IF(LNG.EQ.2) THEN
00317             IF(ABS(MASTEN(ITRAC)).GT.1.D-8) WRITE(LU,2161) MASTEN(ITRAC)
00318             IF(ABS(MASTOU(ITRAC)).GT.1.D-8) WRITE(LU,2164) MASTOU(ITRAC)
00319           ENDIF
00320 !
00321         ENDIF
00322 !
00323       ENDIF
00324 !
00325 !-----------------------------------------------------------------------
00326 !  FINAL MASS BALANCE
00327 !
00328       IF(LT.EQ.NIT) THEN
00329 !
00330         IF(LNG.EQ.1) WRITE(LU,600) ITRAC
00331         IF(LNG.EQ.2) WRITE(LU,601) ITRAC
00332 !
00333         PERDUE = MASTR0(ITRAC)+MASTEN(ITRAC)+
00334      &           MASBOR+MASTOU(ITRAC)-MASTR2(ITRAC)
00335 !
00336         IF(LNG.EQ.1) THEN
00337           WRITE(LU,1160) MASTR0(ITRAC),MASTR2(ITRAC)
00338           WRITE(LU,1165) PERDUE
00339         ENDIF
00340         IF(LNG.EQ.2) THEN
00341           WRITE(LU,2160) MASTR0(ITRAC),MASTR2(ITRAC)
00342           WRITE(LU,2165) PERDUE
00343         ENDIF
00344 !
00345       ENDIF
00346 !
00347 !  END OF PRINTS
00348 !
00349 !=======================================================================
00350 !
00351 !  PRINT FORMATS:
00352 !
00353 500   FORMAT(80(' '),/,22X,'BILAN DE QUANTITE DU TRACEUR ',1I2)
00354 501   FORMAT(80(' '),/,21X,'BALANCE OF TRACER ',1I2)
00355 600   FORMAT(80('-'),/,20X,'BILAN FINAL DE QUANTITE DU TRACEUR ',1I2)
00356 601   FORMAT(80('-'),/,19X,'FINAL BALANCE OF TRACER ',1I2)
00357 1090  FORMAT(5X,'QUANTITE INITIALE DE TRACEUR :',G16.7,' UNITE M3')
00358 2090  FORMAT(5X,'INITIAL QUANTITY OF TRACER:',G16.7,' TRACER UNIT M3')
00359 1100  FORMAT(/,5X,'QUANTITE DE TRACEUR :',G16.7,' UNITE M3')
00360 2100  FORMAT(/,5X,'QUANTITY OF TRACER:',G16.7,' TRACER UNIT M3')
00361 1110  FORMAT(5X,'FLUX IMPOSE DE TRACEUR :           ' , G16.7 ,
00362      &          '  ( >0 : ENTRANT  <0 : SORTANT )')
00363 1111  FORMAT(5X,'FLUX LIBRE DE TRACEUR :            ' , G16.7 ,
00364      &          '  ( >0 : ENTRANT  <0 : SORTANT )')
00365 1112  FORMAT(5X,'FLUX INCIDENT DE TRACEUR :         ' , G16.7 ,
00366      &          '  ( >0 : ENTRANT  <0 : SORTANT )')
00367 1113  FORMAT(5X,'QUANTITE CREEE PAR TERME SOURCE :  ' , G16.7 )
00368 !1114  FORMAT(5X,'QUANTITE AJOUTEE ( CDT. LIM. )  :  ' , G16.7 )
00369 2110  FORMAT(5X,'PRESCRIBED FLUX OF TRACER:         ' , G16.7 ,
00370      &          '  ( >0 : ENTERING  <0 : EXITING )')
00371 2111  FORMAT(5X,'FREE FLUX OF TRACER:               ' , G16.7 ,
00372      &          '  ( >0 : ENTERING  <0 : EXITING )')
00373 2112  FORMAT(5X,'INCIDENT FLUX OF TRACER:           ' , G16.7 ,
00374      &          '  ( >0 : ENTERING  <0 : EXITING )')
00375 2113  FORMAT(5X,'QUANTITY CREATED BY SOURCE TERM:   ' , G16.7 )
00376 !1120  FORMAT(5X,'ERREUR RELATIVE SUR LE TRACEUR : ',G16.7)
00377 !2120  FORMAT(5X,'RELATIVE ERROR ON TRACER : ',G16.7)
00378 !1130  FORMAT(5X,'ERREUR ABSOLUE SUR LE TRACEUR : ',G16.7)
00379 !2130  FORMAT(5X,'ABSOLUTE ERROR ON TRACER : ',G16.7)
00380 1140  FORMAT(/,5X,'ERREUR RELATIVE CUMULEE SUR LE TRACEUR : ',G16.7)
00381 2140  FORMAT(/,5X,'RELATIVE ERROR CUMULATED ON TRACER: ',G16.7)
00382 1150  FORMAT(/,5X,'ERREUR ABSOLUE  CUMULEE SUR LE TRACEUR : ',G16.7)
00383 2150  FORMAT(/,5X,'ABSOLUTE ERROR CUMULATED ON TRACER: ',G16.7)
00384 1160  FORMAT(/,5X,'QUANTITE INITIALE DU TRACEUR      : ',G16.7,
00385      &       /,5X,'QUANTITE FINALE                   : ',G16.7)
00386 1161  FORMAT(  5X,'QUANTITE ENTREE AUX FRONT. LIQUID.: ',G16.7,
00387      &            '  ( SI <0 QUANTITE SORTIE )')
00388 1164  FORMAT(  5X,'QUANTITE CREEE PAR TERME SOURCE   : ',G16.7)
00389 1165  FORMAT(  5X,'QUANTITE TOTALE PERDUE            : ',G16.7)
00390 2160  FORMAT(/,5X,'INITIAL QUANTITY OF TRACER        : ',G16.7,
00391      &       /,5X,'FINAL QUANTITY                    : ',G16.7)
00392 2161  FORMAT(  5X,'QUANTITY ENTERED THROUGH LIQ. BND.: ',G16.7,
00393      &            '  ( IF <0 EXIT )')
00394 2164  FORMAT(  5X,'QUANTITY CREATED BY SOURCE TERM   : ',G16.7)
00395 2165  FORMAT(  5X,'TOTAL QUANTITY LOST               : ',G16.7)
00396 !
00397 !=======================================================================
00398 !
00399       RETURN
00400       END

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