correction_depth_2d.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac2d\correction_depth_2d.f
00002 !
00120                      SUBROUTINE CORRECTION_DEPTH_2D
00121 !                    ******************************
00122 !
00123      &(GLOSEG,DIMGLO,YAFLODEL,YASMH,YAFLULIM)
00124 !
00125 !***********************************************************************
00126 ! TELEMAC2D   V6P2                                   21/08/2010
00127 !***********************************************************************
00128 !
00129 !
00130 !
00131 !
00132 !
00133 !
00134 !
00135 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00136 !| DIMGLO         |-->| FIRST DIMENSION OF GLOSEG
00137 !| GLOSEG         |-->| GLOBAL NUMBERS OF APICES OF SEGMENTS
00138 !| YAFLODEL       |<--| IF YES, FLODEL HAS BEEN COMPUTED
00139 !| YAFLULIM       |<->| IF YES, FLULIM WILL BE APPLIED TO SEGMENT FLUXES
00140 !|                |   | WHEN CALLING CVDFTR
00141 !| YASMH          |-->| THE RIGHT-HAND SIDE SMH HAS TO BE TAKEN
00142 !|                |   | INTO ACCOUNT
00143 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00144 !
00145       USE BIEF
00146       USE INTERFACE_TELEMAC2D,
00147      &                     EX_CORRECTION_DEPTH_2D => CORRECTION_DEPTH_2D
00148       USE DECLARATIONS_TELEMAC
00149       USE DECLARATIONS_TELEMAC2D
00150 !
00151       IMPLICIT NONE
00152       INTEGER LNG,LU
00153       COMMON/INFO/LNG,LU
00154 !
00155 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00156 !
00157       INTEGER, INTENT(IN)    :: DIMGLO
00158       INTEGER, INTENT(IN)    :: GLOSEG(DIMGLO,2)
00159       LOGICAL, INTENT(IN)    :: YASMH
00160       LOGICAL, INTENT(INOUT) :: YAFLULIM,YAFLODEL
00161 !
00162 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00163 !
00164       INTEGER IOPT1
00165       CHARACTER(LEN=16) :: FORMUL
00166 !
00167 !-----------------------------------------------------------------------
00168 !
00169 !     CASES OF COMPUTATION OF FLODEL
00170 !
00171       IF(  INCLUS(COUPLING,'DELWAQ')  .OR.
00172      &   ((OPTBAN.EQ.1.OR.OPTBAN.EQ.3).AND.OPT_HNEG.EQ.2) ) THEN
00173         FORMUL='HUGRADP         '
00174         IF(SOLSYS.EQ.2) FORMUL(8:8)='2'
00175 !
00176 !       HERE ASSEMBLING T1 IS NOT USEFUL, HENCE LEGO=.FALSE.
00177 !
00178         CALL VECTOR(T1,'=',FORMUL,H%ELM,-1.D0,
00179      &              HPROP,DM1,ZCONV,UDEL,VDEL,VDEL,MESH,MSK,MASKEL,
00180      &              LEGO=.FALSE.)
00181 !                   T1 AS HUGRADP IS NOT USED AS AN ASSEMBLED VECTOR
00182 !                   BUT TO GET THE NON ASSEMBLED FORM MESH%W
00183 !
00184 !       COMPUTING FLODEL, SO FAR IOPT1 HARDCODED OPTION
00185         IOPT1=2
00186         CALL FLUX_EF_VF(FLODEL%R,MESH%W%R,MESH%NSEG,MESH%NELEM,
00187      &                  MESH%ELTSEG%I,MESH%ORISEG%I,
00188      &                  MESH%IKLE%I,.TRUE.,IOPT1)
00189         YAFLODEL=.TRUE.
00190       ENDIF
00191 !
00192       IF(OPTBAN.EQ.1.OR.OPTBAN.EQ.3) THEN
00193       IF(DEBUG.GT.0) WRITE(LU,*) 'TRAITEMENT BANCS DECOUVRANTS'
00194 !
00195       IF(OPT_HNEG.EQ.2) THEN
00196 !
00197 !     LIMITS FLUXES TO HAVE POSITIVE DEPTHS
00198 !     BEWARE, WILL BE ONLY VALID FOR ADVECTION WITH UDEL,VDEL
00199 !     HENCE FOR TRACERS AND IF SOLSYS=2
00200 !     FLULIM WILL BE CORRECT AT THE EXIT OF POSITIVE_DEPTHS
00201       YAFLULIM=.TRUE.
00202 !
00203       IF(.NOT.RAIN) THEN
00204 !
00205 !     CASE ONLY SMH OR NOTHING
00206 !
00207       CALL POSITIVE_DEPTHS(T1,T2,T3,T4,H,HN,MESH,FLODEL,.FALSE.,
00208      &                     FLBOR,DT,UNSV2D,
00209      &                     NPOIN,GLOSEG(1:DIMGLO,1),GLOSEG(1:DIMGLO,2),
00210      &                     MESH%NBOR%I,MESH%NPTFR,
00211      &                     SMH,YASMH,
00212      &                     OPTSOU,FLULIM%R,LIMPRO%I,HBOR%R,KDIR,ENTET,
00213      &                     MESH%W%R,NAMECODE,2,MAXADV)
00214 !                                            2 HARDCODED OPTION
00215 !                                            FOR POSITIVE DEPTH ALGORITHM
00216 !                                            INDEPENDENT OF SEGMENT
00217 !                                            NUMBERING
00218 !
00219       ELSEIF(YASMH) THEN
00220 !
00221 !     CASE SMH AND RAIN
00222 !
00223       IF(OPTSOU.EQ.1) THEN
00224         CALL OS('X=Y+Z   ',X=T5,Y=SMH,Z=PLUIE)
00225       ELSE
00226         CALL OS('X=Y     ',X=T5,Y=SMH)
00227         CALL OS('X=X+YZ  ',X=T5,Y=PLUIE,Z=V2DPAR)
00228       ENDIF
00229       CALL POSITIVE_DEPTHS(T1,T2,T3,T4,H,HN,MESH,FLODEL,.FALSE.,
00230      &                     FLBOR,DT,UNSV2D,
00231      &                     NPOIN,GLOSEG(1:DIMGLO,1),GLOSEG(1:DIMGLO,2),
00232      &                     MESH%NBOR%I,MESH%NPTFR,
00233      &                     T5,.TRUE.,
00234      &                     OPTSOU,FLULIM%R,LIMPRO%I,HBOR%R,KDIR,ENTET,
00235      &                     MESH%W%R,NAMECODE,2,MAXADV)
00236 !
00237       ELSE
00238 !
00239 !     CASE ONLY RAIN
00240 !
00241       CALL POSITIVE_DEPTHS(T1,T2,T3,T4,H,HN,MESH,FLODEL,.FALSE.,
00242      &                     FLBOR,DT,UNSV2D,
00243      &                     NPOIN,GLOSEG(1:DIMGLO,1),GLOSEG(1:DIMGLO,2),
00244      &                     MESH%NBOR%I,MESH%NPTFR,
00245      &                     PLUIE,RAIN,
00246      &                     1,FLULIM%R,LIMPRO%I,HBOR%R,KDIR,ENTET,
00247      &                     MESH%W%R,NAMECODE,2,MAXADV)
00248 !
00249       ENDIF
00250 !
00251       ELSEIF(OPT_HNEG.EQ.1) THEN
00252 !
00253 !     CONSERVATIVE SMOOTHING OF THE NEGATIVE DEPTHS
00254 !
00255 !     1) OPTIONAL THRESHOLD (HNEG IS NEGATIVE)
00256 !
00257       IF(HNEG.LT.-1.D-6) CALL OS('X=X+C   ',X=H,C=-HNEG)
00258 !
00259 !     2) NEGATIVE DEPTHS IN T1 AND TAKEN OUT OF H
00260 !
00261       CALL OS( 'X=-(Y,C)' , X=T1 , Y=H  , C=0.D0 )
00262       CALL OS( 'X=X-Y   ' , X=H  , Y=T1 )
00263 !
00264 !     3) NEGATIVE DEPTHS ARE SMOOTHED (TWICE HERE)
00265 !        AND MASKED TO AVOID SPREAD OVER THE WETTING/DRYING AREAS
00266 !
00267       IF(OPTBAN.EQ.1) THEN
00268         CALL FILTER_H(T1,T2,MESH,MSK,MASKEL,2,FLODEL,
00269      &                YAFLODEL,DT,W1,UNSV2D)
00270       ELSEIF(OPTBAN.EQ.3) THEN
00271 !            FILTER_H DOES NOT WORK WITH POROSITY
00272 !       CALL FILTER_H(T1,T2,MESH,.TRUE.,TE5,2,FLODEL,
00273 !    *                YAFLODEL,DT,W1,UNSV2D)
00274 !
00275 !       THIS WILL BE SLIGHTLY WRONG WITH DELWAQ
00276         CALL FILTER(T1,.TRUE.,T2,T3,
00277      &              AM1,'MATMAS          ',
00278      &              1.D0,S,S,S,S,S,S,MESH,.TRUE.,TE5,2)
00279       ENDIF
00280 !
00281 !     4) SMOOTHED NEGATIVE DEPTHS TRANSFERRED BACK TO H
00282 !
00283       CALL OS( 'X=X+Y   ' , X=H , Y=T1 )
00284 !
00285 !     5) OPTIONAL THRESHOLD IS SUBTRACTED
00286 !
00287       IF(HNEG.LT.-1.D-6) CALL OS('X=X+C   ',X=H,C=HNEG)
00288 !
00289       ENDIF
00290 !
00291 !     HREC IS THE THRESHOLD DEPTH FOR RECEDING PROCEDURE
00292 !     RECEDING PROCEDURE, TO PREVENT SPURIOUS OVERWHELMING OF DYKES
00293 !     WHEN MESH TOO COARSE...
00294 !
00295       IF(HREC.GT.0.D0.AND.OPT_HNEG.EQ.2.AND.
00296      &    (OPTBAN.EQ.1.OR.OPTBAN.EQ.3)) THEN
00297 !       HERE FLODEL HAS ALREADY BEEN BUILT, IT WILL BE MODIFIED
00298         CALL CPSTVC(H,T1)
00299         CALL CPSTVC(H,T2)
00300         CALL RECEDING(H%R,ZF%R,HREC,V2DPAR%R,VOLU2D%R,MESH%IKLE%I,
00301      &                NPOIN,MESH%NELEM,MESH%NELMAX,T1,T2,MESH,
00302      &                W1%R,YAFLODEL,FLODEL,DT)
00303       ENDIF
00304 !
00305 !     OPTIONAL CLIPPING OF NEGATIVE VALUES
00306       IF(CLIPH) CALL CLIP(H,HMIN,.TRUE.,1.D6,.FALSE.,0)
00307 !
00308       IF(DEBUG.GT.0) WRITE(LU,*) 'FIN DU TRAITEMENT BANCS DECOUVRANTS'
00309       ENDIF
00310 !
00311 !-----------------------------------------------------------------------
00312 !
00313       RETURN
00314       END

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