bilant.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\bilant.f
00002 !
00069                      SUBROUTINE BILANT
00070 !                    *****************
00071 !
00072      &(H,WORK2,WORK3,DT,LT,NIT,INFO,
00073      & T,AGGLOT,MASSOU,MASTR0,MASTR2,MASTEN,
00074      & MASTOU,MSK,MASKEL,MESH,
00075      & FLBOR,NUMLIQ,NFRLIQ,NPTFR,NAMETRAC,FLBORTRA,MASS_RAIN,TRAIN,
00076      & MASTRAIN)
00077 !
00078 !***********************************************************************
00079 ! BIEF   V7P0
00080 !***********************************************************************
00081 !
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00088 !| AGGLOT         |-->| MASS-LUMPING ON TRACER
00089 !| DT             |-->| TIME-STEP
00090 !| FLBOR          |-->| WATER FLUXES AT BOUNDARIES
00091 !| FLBORTRA       |-->| TRACER FLUXES AT BOUNDARIES
00092 !| H              |-->| DEPTH AT TIME N+1.
00093 !| INFO           |-->| LOGICAL, IF YES, PRINTING INFORMATION ON LISTING
00094 !| LT,NIT         |-->| TIME STEP NUMBER, TOTAL NUMBER OF STEPS.
00095 !| MASKEL         |-->| MASKING OF ELEMENTS
00096 !|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
00097 !| MASS_RAIN      |<--| MASS OF WATER ADDED BY RAIN OR EVAPORATION
00098 !| MASSOU         |-->| MASS OF TRACER BROUGTH BY SOURCE TERM
00099 !| MASTEN         |<--| WATER MASS ENTERED THROUGH BOUNDARIES
00100 !| MASTRAIN       |<->| TOTAL WATER MASS ENTERED THROUGH BOUNDARIES
00101 !| MASTOU         |<--| WATER MASS CREATED BY SOURCE TERMS
00102 !| MASTR0         |<--| INITIAL TRACER MASS
00103 !| MASTR2         |<--| CURRENT TRACER MASS
00104 !| MESH           |-->| MESH STRUCTURE
00105 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00106 !| NAMETRAC       |-->| NAMES OF TRACERS
00107 !| NFRLIQ         |-->| NUMBER OF LIQUID BOUNDARIES
00108 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00109 !| NUMLIQ         |-->| NUMBER OF LIQUID BOUNDARIES
00110 !| T              |-->| TRACER AT TIME T(N+1)
00111 !| TRAIN          |-->| VALUE OF TRACER IN THE RAIN
00112 !| WORK2          |<->| WORK ARRAY
00113 !| WORK3          |<->| WORK ARRAY
00114 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00115 !
00116       USE BIEF, EX_BILANT => BILANT
00117 !
00118       IMPLICIT NONE
00119       INTEGER LNG,LU
00120       COMMON/INFO/LNG,LU
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       INTEGER, INTENT(IN)            :: LT,NIT,NFRLIQ,NPTFR
00125       INTEGER, INTENT(IN)            :: NUMLIQ(NPTFR)
00126       DOUBLE PRECISION, INTENT(IN)   :: DT,MASSOU,AGGLOT,MASS_RAIN,TRAIN
00127       DOUBLE PRECISION, INTENT(INOUT):: MASTRAIN
00128       LOGICAL, INTENT(IN)            :: INFO,MSK
00129       TYPE(BIEF_OBJ), INTENT(INOUT)  :: WORK2,WORK3
00130       TYPE(BIEF_OBJ), INTENT(IN)     :: H,T,MASKEL,FLBOR
00131       TYPE(BIEF_OBJ), INTENT(IN)     :: FLBORTRA
00132       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00133       DOUBLE PRECISION, INTENT(INOUT):: MASTR0,MASTR2,MASTEN,MASTOU
00134       CHARACTER(LEN=32), INTENT(IN)  :: NAMETRAC
00135 !
00136 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00137 !
00138       DOUBLE PRECISION P_DSUM
00139       EXTERNAL         P_DSUM
00140 !
00141       INTEGER I,IFRLIQ,IELMT,IELMH
00142 !
00143       DOUBLE PRECISION ERREUT,PERDUE,FLUXT,MASBOR,RELATI,DENOM,MASTR1
00144       DOUBLE PRECISION MASRAI
00145 !     300 IS HERE MAXFRO, THE MAXIMUM NUMBER OF LIQUID BOUNDARIES
00146       DOUBLE PRECISION FLT_BOUND(300)
00147 !
00148       INTRINSIC ABS,MAX
00149 !
00150 !-----------------------------------------------------------------------
00151 !
00152       IELMT = T%ELM
00153       IELMH = H%ELM
00154 !
00155 !-----------------------------------------------------------------------
00156 !
00157 !  COMPATIBLE COMPUTATION OF THE TRACER QUANTITY AT TIME N+1:
00158 !  TAKES MASS-LUMPING INTO ACCOUNT BUT REQUIRES AGGLOC=AGGLOT
00159 !
00160       IF(LT.NE.0) MASTR1 = MASTR2
00161 !
00162       CALL VECTOR(WORK2,'=','MASVEC          ',IELMT,
00163      &            1.D0-AGGLOT,T,T,T,T,T,T,MESH,MSK,MASKEL)
00164 !     H IS GIVEN HERE FOR A DUMMY STRUCTURE
00165       CALL VECTOR(WORK3,'=','MASBAS          ',IELMT,
00166      &                 AGGLOT,H,H,H,H,H,H,MESH,MSK,MASKEL)
00167 !
00168       CALL OS('X=X+YZ  ',X=WORK2,Y=WORK3,Z=T)
00169 !
00170       MASTR2 = DOTS(WORK2,H)
00171       IF(NCSIZE.GT.1) MASTR2=P_DSUM(MASTR2)
00172 !
00173       IF(LT.EQ.0) THEN
00174         MASTR0   = MASTR2
00175         MASTR1   = MASTR2
00176         MASTEN   = 0.D0
00177         MASTOU   = 0.D0
00178         MASTRAIN = 0.D0
00179       ENDIF
00180 !
00181 !=======================================================================
00182 !
00183 !   COMPUTES THE FLUXES (MISSES THE DIFFUSION FLUX,... INVESTIGATE)
00184 !
00185 !=======================================================================
00186 !
00187       FLUXT=0.D0
00188 !
00189       IF(LT.GT.0.AND.NFRLIQ.GT.0) THEN
00190         DO IFRLIQ=1,NFRLIQ
00191           FLT_BOUND(IFRLIQ)=0.D0
00192         ENDDO
00193         IF(NPTFR.GT.0) THEN
00194           DO I=1,NPTFR
00195 !           NOTE: COULD DEFINE FLUX_BOUNDARIES BETWEEN 0 AND NFRLIQ
00196             IFRLIQ=NUMLIQ(I)
00197             IF(IFRLIQ.GT.0) THEN
00198 !             FLBORTRA MUST NOT BE ASSEMBLED IN PARALLEL MODE
00199               FLT_BOUND(IFRLIQ)=FLT_BOUND(IFRLIQ)+FLBORTRA%R(I)
00200             ENDIF
00201           ENDDO
00202         ENDIF
00203         IF(NCSIZE.GT.1) THEN
00204           DO IFRLIQ=1,NFRLIQ
00205             FLT_BOUND(IFRLIQ)=P_DSUM(FLT_BOUND(IFRLIQ))
00206           ENDDO
00207         ENDIF
00208         DO IFRLIQ=1,NFRLIQ
00209           FLUXT=FLUXT+FLT_BOUND(IFRLIQ)
00210         ENDDO
00211       ENDIF
00212 !
00213 !=======================================================================
00214 !
00215 !     COMPUTES THE FLUXES AT THE LIQUID BOUNDARIES
00216 !
00217       MASTEN = MASTEN - FLUXT * DT
00218       MASTOU = MASTOU + MASSOU
00219 !
00220 !=======================================================================
00221 !
00222 !     COMPUTES THE TRACER FLUXES THRU THE WALLS (FLUX LAW)
00223 !
00224 !     TEMPORARY, TO BE CODED UP
00225       MASBOR = 0.D0
00226 !
00227 !=======================================================================
00228 !
00229 !     COMPUTES THE TRACER MASS BROUGHT BY THE RAIN
00230 !     MAX(...,0.D0) BECAUSE EVAPORATION IS NOT TAKEN INTO ACCOUNT
00231 !
00232 !     WILL WORK ONLY IF TRAIN AND RAIN CONSTANT ON ALL THE DOMAIN...
00233       MASRAI = MAX(MASS_RAIN,0.D0) * TRAIN
00234       IF(NCSIZE.GT.1) MASRAI=P_DSUM(MASRAI)
00235       MASTRAIN = MASTRAIN + MASRAI
00236 !
00237 !=======================================================================
00238 !
00239 !     COMPUTES THE ERROR ON THE MASS FOR THIS TIMESTEP
00240 !
00241       ERREUT = MASTR1 + MASSOU + MASRAI - MASTR2 - DT*FLUXT
00242 !
00243 !=======================================================================
00244 !
00245 !     PRINTOUTS :
00246 !
00247       IF(INFO) THEN
00248 !
00249 !-----------------------------------------------------------------------
00250 !
00251 !     PRINTOUTS FOR THE TRACER
00252 !
00253         WRITE(LU,*)
00254         IF(LNG.EQ.1) THEN
00255           WRITE(LU,*) '                      BILAN DE QUANTITE DE ',
00256      &    TRIM(NAMETRAC(1:16)),
00257      &                       ' (UNITE : ',TRIM(NAMETRAC(17:32)),' * M3)'
00258         ENDIF
00259         IF(LNG.EQ.2) THEN
00260           WRITE(LU,*) '                           BALANCE OF ',
00261      &    TRIM(NAMETRAC(1:16)),' (UNIT: ',TRIM(NAMETRAC(17:32)),' * M3)'
00262         ENDIF
00263 !
00264         IF(LT.EQ.0) THEN
00265           IF(LNG.EQ.1) WRITE(LU,1090) MASTR0
00266           IF(LNG.EQ.2) WRITE(LU,2090) MASTR0
00267         ELSE
00268           IF(LNG.EQ.1) WRITE(LU,1160) MASTR1,MASTR2
00269           IF(LNG.EQ.2) WRITE(LU,2160) MASTR1,MASTR2
00270           IF(NFRLIQ.GT.0) THEN
00271             DO IFRLIQ=1,NFRLIQ
00272               IF(LNG.EQ.1) WRITE(LU,1110) IFRLIQ,-FLT_BOUND(IFRLIQ)
00273               IF(LNG.EQ.2) WRITE(LU,2110) IFRLIQ,-FLT_BOUND(IFRLIQ)
00274             ENDDO
00275           ENDIF
00276           IF(ABS(MASSOU).GT.1.D-8) THEN
00277             IF(LNG.EQ.1) WRITE(LU,1113) MASSOU
00278             IF(LNG.EQ.2) WRITE(LU,2113) MASSOU
00279           ENDIF
00280           IF(ABS(MASRAI).GT.1.D-8) THEN
00281             IF(LNG.EQ.1) WRITE(LU,1166) MASRAI
00282             IF(LNG.EQ.2) WRITE(LU,2166) MASRAI
00283           ENDIF
00284           IF(LNG.EQ.1) WRITE(LU,1165) ERREUT
00285           IF(LNG.EQ.2) WRITE(LU,2165) ERREUT
00286 !         ABS BECAUSE THE MASS OF A TRACER CAN BE NEGATIVE
00287 !         EXAMPLE : VORTICITY
00288           DENOM = MAX(ABS(MASTR1),ABS(MASTR2),ABS(FLUXT*DT),
00289      &                ABS(MASRAI),ABS(MASSOU))
00290           IF(DENOM.GT.1.D-8) THEN
00291             ERREUT = ERREUT / DENOM
00292             IF(LNG.EQ.1) WRITE(LU,1120) ERREUT
00293             IF(LNG.EQ.2) WRITE(LU,2120) ERREUT
00294           ENDIF
00295         ENDIF
00296 !
00297       ENDIF
00298 !
00299 !-----------------------------------------------------------------------
00300 !
00301 !  FINAL MASS BALANCE
00302 !
00303       IF(LT.EQ.NIT) THEN
00304 !
00305         WRITE(LU,*)
00306         IF(LNG.EQ.1) THEN
00307           WRITE(LU,*) '                BILAN FINAL DE QUANTITE DE ',
00308      &    TRIM(NAMETRAC(1:16)),
00309      &                       ' (UNITE : ',TRIM(NAMETRAC(17:32)),' * M3)'
00310         ENDIF
00311         IF(LNG.EQ.2) THEN
00312           WRITE(LU,*) '                     FINAL BALANCE OF ',
00313      &    TRIM(NAMETRAC(1:16)),' (UNIT: ',TRIM(NAMETRAC(17:32)),' * M3)'
00314         ENDIF
00315 !
00316         PERDUE = MASTR0+MASTEN+MASBOR+MASTOU+MASTRAIN-MASTR2
00317         DENOM = MAX(ABS(MASTR0),ABS(MASTR2),ABS(MASTEN),
00318      &              ABS(MASTOU),ABS(MASTRAIN))
00319         IF(LNG.EQ.1) THEN
00320           WRITE(LU,1160) MASTR0,MASTR2
00321           IF(ABS(MASTEN).GT.1.D-8) WRITE(LU,1161) MASTEN
00322           IF(ABS(MASTOU).GT.1.D-8) WRITE(LU,1164) MASTOU
00323           IF(ABS(MASTRAIN).GT.1.D-8) WRITE(LU,1166) MASTRAIN
00324           WRITE(LU,1165) PERDUE
00325         ENDIF
00326         IF(LNG.EQ.2) THEN
00327           WRITE(LU,2160) MASTR0,MASTR2
00328           IF(ABS(MASTEN).GT.1.D-8) WRITE(LU,2161) MASTEN
00329           IF(ABS(MASTOU).GT.1.D-8) WRITE(LU,2164) MASTOU
00330           IF(ABS(MASTRAIN).GT.1.D-8) WRITE(LU,2166) MASTRAIN
00331           WRITE(LU,2165) PERDUE
00332         ENDIF
00333         IF(DENOM.GT.1.D-8) THEN
00334           RELATI = PERDUE / DENOM
00335           IF(LNG.EQ.1) WRITE(LU,1120) RELATI
00336           IF(LNG.EQ.2) WRITE(LU,2120) RELATI
00337         ENDIF
00338         WRITE(LU,*)
00339 !
00340       ENDIF
00341 !
00342 !  END OF THE PRINTOUTS :
00343 !
00344 !=======================================================================
00345 !
00346 !  FORMATS :
00347 !
00348 1090  FORMAT(  5X,'QUANTITE INITIALE DE TRACEUR :',G16.7)
00349 2090  FORMAT(  5X,'INITIAL QUANTITY OF TRACER   :',G16.7)
00350 1110  FORMAT(  5X,'FRONTIERE ',1I3,' FLUX :           ',G16.7,
00351      &          ' ( >0 : ENTRANT  <0 : SORTANT )')
00352 1113  FORMAT(  5X,'QUANTITE CREEE PAR TERME SOURCE   :  ' , G16.7 )
00353 2110  FORMAT(  5X,'BOUNDARY ',1I3,' FLUX:         ',G16.7,
00354      &          ' ( >0 : ENTERING  <0 : EXITING )')
00355 2113  FORMAT(  5X,'QUANTITY CREATED BY SOURCE TERM   :   ' , G16.7 )
00356 1120  FORMAT(  5X,'ERREUR RELATIVE                   : ',G16.7)
00357 2120  FORMAT(  5X,'RELATIVE ERROR                    : ',G16.7)
00358 1160  FORMAT(/,5X,'QUANTITE INITIALE                 : ',G16.7,
00359      &       /,5X,'QUANTITE FINALE                   : ',G16.7)
00360 1161  FORMAT(  5X,'QUANTITE ENTREE AUX FRONT. LIQUID.: ',G16.7,
00361      &            '  ( SI <0 QUANTITE SORTIE )')
00362 1164  FORMAT(  5X,'QUANTITE CREEE PAR TERME SOURCE   : ',G16.7)
00363 1166  FORMAT(  5X,'QUANTITE APPORTEE PAR LA PLUIE    : ',G16.7)
00364 1165  FORMAT(  5X,'QUANTITE TOTALE PERDUE            : ',G16.7)
00365 2160  FORMAT(/,5X,'INITIAL QUANTITY                  : ',G16.7,
00366      &       /,5X,'FINAL QUANTITY                    : ',G16.7)
00367 2161  FORMAT(  5X,'QUANTITY ENTERED THROUGH LIQ. BND.: ',G16.7,
00368      &            '  ( IF <0 EXIT )')
00369 2164  FORMAT(  5X,'QUANTITY CREATED BY SOURCE TERM   : ',G16.7)
00370 2166  FORMAT(  5X,'MASS BROUGHT BY THE RAIN          : ',G16.7)
00371 2165  FORMAT(  5X,'TOTAL QUANTITY LOST               : ',G16.7)
00372 !
00373 !=======================================================================
00374 !
00375       RETURN
00376       END

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