bilan.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\bilan.f
00002 !
00066                      SUBROUTINE BILAN
00067 !                    ****************
00068 !
00069      &(MESH,H,WORK,MASK,AT,DT,LT,NIT,INFO,MASSES,MSK,MASKEL,EQUA,POROS,
00070      & OPTBAN,NPTFR,FLBOR,FLUX_BOUNDARIES,NUMLIQ,NFRLIQ,GAMMA)
00071 !
00072 !***********************************************************************
00073 ! TELEMAC2D   V6P2                                   21/08/2010
00074 !***********************************************************************
00075 !
00076 !
00077 !
00078 !
00079 !
00080 ! history R. ATA(LNHE)
00081 !         06/01/2012
00082 !         V6P0
00083 !     ADAPTATION FOR FV
00084 !
00085 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00086 !| AT             |-->| TIME IN SECONDS
00087 !| DT             |-->| TIME STEP IN SECONDS
00088 !| EQUA           |-->| STRING DESCRIBING THE EQUATIONS SOLVED
00089 !| FLBOR          |-->| FLUXES AT BOUNDARY POINTS
00090 !| FLUX_BOUNDARIES|-->| FLUXES OF LIQUID BOUNDARIES
00091 !| H              |-->| DEPTH AT TIME N+1.
00092 !| INFO           |-->| IF YES, PRINTING INFORMATIONS
00093 !| LT             |-->| TIME STEP NUMBER
00094 !| MASK           |-->| BLOCK OF MASKS FOR DIFFERENT BOUNDARY CONDITIONS
00095 !| MASKEL         |-->| MASKING OF ELEMENTS
00096 !|                |   | =1. : NORMAL   =0. : MASKED ELEMENT
00097 !| MASSES         |-->| MASS OF TRACER ADDED BY SOURCE TERM
00098 !|                |   | SEE DIFSOU
00099 !| MESH           |-->| MESH STRUCTURE
00100 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00101 !| NFRLIQ         |-->| NUMBER OF LIQUID BOUNDARIES
00102 !| NIT            |-->| TOTAL NUMBER OF TIME STEPS
00103 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00104 !| NUMLIQ         |-->| LIQUID BOUNDARY NUMBER OF BOUNDARY POINTS
00105 !| OPTBAN         |-->| OPTION FOR THE TREATMENT OF TIDAL FLATS
00106 !| POROS          |-->| POROSITY, PER ELEMENT.
00107 !| WORK           |-->| WORK ARRAY
00108 !| GAMMA          |-->| NEWMARK COEFFICIENT FOR TIME INTEGRATION
00109 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00110 !
00111       USE BIEF
00112 !
00113       IMPLICIT NONE
00114       INTEGER LNG,LU
00115       COMMON/INFO/LNG,LU
00116 !
00117 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00118 !
00119 !     SIZE OF NUMLIQ AND FLUX_BOUNDARIES IS NFRLIQ BUT NFRLIQ
00120 !     CAN BE 0.
00121 !
00122       INTEGER, INTENT(IN)            :: LT,NIT,OPTBAN,NPTFR,NFRLIQ
00123       INTEGER, INTENT(IN)            :: NUMLIQ(*)
00124       CHARACTER(LEN=20), INTENT(IN)  :: EQUA
00125       LOGICAL, INTENT(IN)            :: INFO,MSK
00126       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00127       TYPE(BIEF_OBJ), INTENT(INOUT)  :: WORK,FLBOR
00128       TYPE(BIEF_OBJ), INTENT(IN)     :: H,MASKEL,POROS,MASK
00129       DOUBLE PRECISION, INTENT(IN)   :: AT,DT,GAMMA
00130       DOUBLE PRECISION, INTENT(INOUT):: MASSES,FLUX_BOUNDARIES(*)
00131 !
00132 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00133 !
00134       INTEGER I
00135 !
00136       DOUBLE PRECISION P_DSUM
00137       EXTERNAL         P_DSUM
00138 !
00139       DOUBLE PRECISION ERREUR,FLUX1,PERDUE,DENOM
00140       DOUBLE PRECISION MASSE0,MASSE1,MASSE2,MASENT,RELATI,MASSET
00141 !
00142       DOUBLE PRECISION FLUX1_OLD,CONTRIB
00143       INTRINSIC ABS
00144 !
00145       SAVE MASSE0,MASSE1,MASSE2,MASENT,MASSET,FLUX1_OLD
00146 !
00147 !-----------------------------------------------------------------------
00148 !
00149 !  COMPATIBLE CALCULATION OF THE MASS OF WATER
00150 !
00151       IF(LT.NE.0) MASSE1 = MASSE2
00152 !
00153       IF(EQUA(1:15).EQ.'SAINT-VENANT VF') THEN
00154         CALL VECTOR(WORK,'=','MASBAS          ',H%ELM,
00155      &              1.D0,H,H,H,H,H,H,MESH,MSK,MASKEL)
00156         CALL OS( 'X=XY    ' , X=WORK , Y=H )
00157       ELSEIF(OPTBAN.EQ.3) THEN
00158         CALL VECTOR(WORK,'=','MASVEC          ',H%ELM,
00159      &              1.D0,H,H,H,H,H,H,MESH,.TRUE.,POROS)
00160       ELSE
00161         CALL VECTOR(WORK,'=','MASVEC          ',H%ELM,
00162      &              1.D0,H,H,H,H,H,H,MESH,MSK,MASKEL)
00163       ENDIF
00164       MASSE2 = BIEF_SUM(WORK)
00165 !
00166       IF(NCSIZE.GT.1) MASSE2 = P_DSUM(MASSE2)
00167 !
00168       IF(LT.EQ.0) THEN
00169         MASSE0 = MASSE2
00170         MASSE1 = MASSE2
00171         MASENT = 0.D0
00172         MASSET = 0.D0
00173         FLUX1_OLD = 0.D0
00174 !
00175 !       FOR THE FIRST CALL, RETURN HERE
00176 !
00177         CALL OS('X=0     ',X=FLBOR)
00178         IF(NFRLIQ.GT.0) THEN
00179           DO I=1,NFRLIQ
00180             FLUX_BOUNDARIES(I)=0.D0
00181           ENDDO
00182         ENDIF
00183         RETURN
00184 !
00185       ENDIF
00186 !
00187 !-----------------------------------------------------------------------
00188 !
00189 !   SOURCE TERMS ADDED TO MASS
00190 !
00191       IF(NCSIZE.GT.1) MASSES = P_DSUM(MASSES)
00192       MASSET = MASSET + MASSES
00193 !
00194 !=======================================================================
00195 !
00196 !   CALCULATES FLUXES AT THE LIQUID BOUDNARIES
00197 !
00198       IF(NFRLIQ.GT.0) THEN
00199         DO I=1,NFRLIQ
00200           FLUX_BOUNDARIES(I)=0.D0
00201         ENDDO
00202         IF(NPTFR.GT.0) THEN
00203           DO I=1,NPTFR
00204 !           NOTE: ONE COULD DEFINE FLUX_BOUNDARIES BETWEEN 0 AND NFRLIQ
00205             IF(NUMLIQ(I).GT.0) THEN
00206               FLUX_BOUNDARIES(NUMLIQ(I))=
00207      &        FLUX_BOUNDARIES(NUMLIQ(I))+FLBOR%R(I)
00208             ENDIF
00209           ENDDO
00210         ENDIF
00211         IF(NCSIZE.GT.1) THEN
00212           DO I=1,NFRLIQ
00213             FLUX_BOUNDARIES(I)=P_DSUM(FLUX_BOUNDARIES(I))
00214           ENDDO
00215         ENDIF
00216       ENDIF
00217 !
00218 !=======================================================================
00219 !
00220 !   TOTAL FLUX AT THE LIQUID BOUNDARY
00221 !
00222       FLUX1=0.D0
00223       IF(NFRLIQ.GT.0) THEN
00224         DO I=1,NFRLIQ
00225           FLUX1=FLUX1+FLUX_BOUNDARIES(I)
00226         ENDDO
00227       ENDIF
00228 !
00229 !=======================================================================
00230 !
00231       IF(EQUA(1:15).EQ.'SAINT-VENANT VF') THEN
00232         CONTRIB = DT*( (1-GAMMA)*FLUX1_OLD + GAMMA*FLUX1)
00233         MASENT = MASENT - CONTRIB
00234       ELSE
00235         MASENT = MASENT - FLUX1*DT
00236       ENDIF
00237 !
00238 !=======================================================================
00239 !
00240 !   COMPUTES ERROR FOR THIS TIME STEP
00241 !
00242       IF(EQUA(1:15).EQ.'SAINT-VENANT VF') THEN
00243         ERREUR = MASSE1 + MASSES - MASSE2 - CONTRIB
00244         FLUX1_OLD = FLUX1
00245       ELSE
00246         ERREUR = MASSE1 + MASSES - MASSE2 - DT*FLUX1
00247       ENDIF
00248 !
00249 !=======================================================================
00250 !
00251 !   PRINTS:
00252 !
00253       IF(INFO) THEN
00254 !
00255 !-----------------------------------------------------------------------
00256 !
00257 !     PRINTS THE MASS OF WATER
00258 !
00259         IF(LT.EQ.0) THEN
00260 !
00261           CALL ENTETE(7,AT,LT)
00262           IF(LNG.EQ.1) WRITE(LU,1000) MASSE0
00263           IF(LNG.EQ.2) WRITE(LU,2000) MASSE0
00264 !
00265         ELSE
00266 !
00267           CALL ENTETE(7,AT,LT)
00268           IF(LNG.EQ.1) THEN
00269             WRITE(LU,1010) MASSE2
00270             IF(NFRLIQ.GT.0) THEN
00271               DO I=1,NFRLIQ
00272                 WRITE(LU,3020) I,-FLUX_BOUNDARIES(I)
00273               ENDDO
00274             ENDIF
00275           ENDIF
00276           IF(LNG.EQ.2) THEN
00277             WRITE(LU,2010) MASSE2
00278             IF(NFRLIQ.GT.0) THEN
00279               DO I=1,NFRLIQ
00280                 WRITE(LU,4020) I,-FLUX_BOUNDARIES(I)
00281               ENDDO
00282             ENDIF
00283           ENDIF
00284           IF(ABS(MASSES).GT.1.D-6) THEN
00285             IF(LNG.EQ.1) WRITE(LU,1031) MASSES
00286             IF(LNG.EQ.2) WRITE(LU,2031) MASSES
00287           ENDIF
00288 !         CALCULATES THE RELATIVE OR ABSOLUTE ERROR
00289           DENOM = MAX(MASSE2,ABS(FLUX1*DT))
00290           IF(DENOM.GT.1.D-8) THEN
00291             ERREUR = ERREUR / DENOM
00292             IF(LNG.EQ.1) WRITE(LU,1040) AT,ERREUR
00293             IF(LNG.EQ.2) WRITE(LU,2040) AT,ERREUR
00294           ELSE
00295             IF(LNG.EQ.1) WRITE(LU,1050) AT,ERREUR
00296             IF(LNG.EQ.2) WRITE(LU,2050) AT,ERREUR
00297           ENDIF
00298 !
00299         ENDIF
00300 !
00301       ENDIF
00302 !
00303 !-----------------------------------------------------------------------
00304 !
00305 !  FINAL MASS BALANCE
00306 !
00307       IF(LT.EQ.NIT.AND.INFO) THEN
00308 !
00309         CALL ENTETE(8,AT,LT)
00310 !       PERDUE = MASSE0+MASSET+MASENT+MASAJT-MASSE2
00311         PERDUE = MASSE0+MASSET+MASENT-MASSE2
00312         DENOM = MAX( MASSE0 , MASSE2 , ABS(MASENT) )
00313         IF(DENOM.GT.1.D-8) THEN
00314           RELATI = PERDUE / DENOM
00315           IF(LNG.EQ.1) WRITE(LU,1060) RELATI
00316           IF(LNG.EQ.2) WRITE(LU,2060) RELATI
00317         ELSE
00318           RELATI = PERDUE
00319           IF(LNG.EQ.1) WRITE(LU,1070) RELATI
00320           IF(LNG.EQ.2) WRITE(LU,2070) RELATI
00321         ENDIF
00322         IF(LNG.EQ.1) THEN
00323           WRITE(LU,1080) MASSE0,MASSE2
00324           IF(ABS(MASENT).GT.1.D-8) WRITE(LU,1081) MASENT
00325           IF(ABS(MASSET).GT.1.D-8) WRITE(LU,1082) MASSET
00326 !         IF(ABS(MASAJT).GT.1.D-8) WRITE(LU,1083) MASAJT
00327           WRITE(LU,1084) PERDUE
00328         ENDIF
00329         IF(LNG.EQ.2) THEN
00330           WRITE(LU,2080) MASSE0,MASSE2
00331           IF(ABS(MASENT).GT.1.D-8) WRITE(LU,2081) MASENT
00332           IF(ABS(MASSET).GT.1.D-8) WRITE(LU,2082) MASSET
00333 !         IF(ABS(MASAJT).GT.1.D-8) WRITE(LU,2083) MASAJT
00334           WRITE(LU,2084) PERDUE
00335         ENDIF
00336 !
00337       ENDIF
00338 !
00339 !  END OF PRINTS
00340 !
00341 !=======================================================================
00342 !
00343 !  PRINT FORMATS:
00344 !
00345 1000  FORMAT(5X,'VOLUME D''EAU INITIAL DANS LE DOMAINE: ',G16.7,' M3')
00346 2000  FORMAT(5X,'INITIAL WATER VOLUME IN THE DOMAIN: ',G16.7,' M3')
00347 !
00348 1010  FORMAT(5X,'VOLUME DANS LE DOMAINE :',G16.7,' M3')
00349 2010  FORMAT(5X,'VOLUME IN THE DOMAIN :',G16.7,' M3')
00350 !
00351 1031  FORMAT(5X,'VOLUME AJOUTE PAR TERME SOURCE : ',G16.7,' M3')
00352 2031  FORMAT(5X,'ADDITIONAL VOLUME DUE TO SOURCE TERMS: ',G16.7,' M3')
00353 !
00354 1040  FORMAT(5X,'ERREUR RELATIVE EN VOLUME A T = ',G16.4,' S : ',G16.7)
00355 2040  FORMAT(5X,'RELATIVE ERROR IN VOLUME AT T = ',G16.4,' S : ',G16.7)
00356 !
00357 1050  FORMAT(5X,'ERREUR ABSOLUE EN VOLUME A T = ',G16.4,' S: ',G16.7)
00358 2050  FORMAT(5X,'ABSOLUTE ERROR IN VOLUME AT T = ',G16.4,'S: ',G16.7)
00359 !
00360 1060  FORMAT(/,5X,'ERREUR RELATIVE CUMULEE SUR LE VOLUME : ',G16.7)
00361 2060  FORMAT(/,5X,'RELATIVE ERROR CUMULATED ON VOLUME: ',G16.7)
00362 !
00363 1070  FORMAT(/,5X,'ERREUR ABSOLUE CUMULEE SUR LE VOLUME : ',G16.7)
00364 2070  FORMAT(/,5X,'ABSOLUTE ERROR CUMULATED ON VOLUME: ',G16.7)
00365 !
00366 1080  FORMAT(/,5X,'VOLUME INITIAL              : ',G16.7,' M3',
00367      &       /,5X,'VOLUME FINAL                : ',G16.7,' M3')
00368 1081  FORMAT(  5X,'VOLUME ENTRE AUX FRONTIERES : ',G16.7,' M3',
00369      &            '  ( SI <0 VOLUME SORTI )')
00370 1082  FORMAT(  5X,'VOLUME AJOUTE ( SOURCES   ) : ',G16.7,' M3')
00371 !1083  FORMAT(  5X,'VOLUME AJOUTE ( CDT. LIM. ) : ',G16.7,' M3')
00372 1084  FORMAT(  5X,'VOLUME TOTAL PERDU          : ',G16.7,' M3')
00373 2080  FORMAT(/,5X,'INITIAL VOLUME              : ',G16.7,' M3',
00374      &       /,5X,'FINAL VOLUME                : ',G16.7,' M3')
00375 2081  FORMAT(  5X,'VOLUME THAT ENTERED THE DOMAIN: ',G16.7,' M3',
00376      &            '  ( IF <0 EXIT )')
00377 2082  FORMAT(  5X,'VOLUME ADDED BY SOURCE TERM   : ',G16.7,' M3')
00378 2084  FORMAT(  5X,'TOTAL VOLUME LOST             : ',G16.7,' M3')
00379 3020  FORMAT(5X,'FLUX FRONTIERE ',I4,' : ', G16.7 ,' M3/S',
00380      &          '  ( >0 : ENTRANT  <0 : SORTANT )')
00381 4020  FORMAT(5X,'FLUX BOUNDARY ',I4,': ', G16.7 ,' M3/S',
00382      &          '  ( >0 : ENTERING  <0 : EXITING )')
00383 !
00384 !=======================================================================
00385 !
00386       RETURN
00387       END

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