flused.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\flused.f
00002 !
00084                      SUBROUTINE FLUSED
00085 !                    *****************
00086 !
00087      &(ATABOF , BTABOF , ATABOS , BTABOS  ,
00088      & LITABF , LITABS , TA     , WC      ,
00089      & X      , Y      , Z      , HN      ,
00090      & GRADZFX, GRADZFY, GRADZSX, GRADZSY ,
00091      & TOB    , FLUDPT , FLUER  , TOCD    ,
00092      & NPOIN3 , NPOIN2 , NPLAN  , KLOG    ,
00093      & HMIN   , SEDCO  , SETDEP , SEDNCO  ,
00094      & WCS    , MIXTE  , FLUDPTC, FLUDPTNC)
00095 !
00096 !***********************************************************************
00097 ! TELEMAC3D   V7P0                                   03/06/2014
00098 !***********************************************************************
00099 !
00100 !
00101 !
00102 !
00103 !
00104 !
00105 !
00106 !
00107 !
00108 !
00109 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00110 !| ATABOF         |<->| FOR BOUNDARY CONDITION (BOTTOM)
00111 !| ATABOS         |<->| FOR BOUNDARY CONDITION (SURFACE) NOT USED
00112 !| BTABOF         |<->| FOR BOUNDARY CONDITION (BOTTOM)
00113 !| BTABOS         |<->| FOR BOUNDARY CONDITION (SURFACE) NOT USED
00114 !| FLUDPT         |<->| IMPLICIT DEPOSITION FLUX
00115 !| FLUDPTC        |<->| IMPLICIT DEPOSITION FLUX FOR COHESIVE SEDIMENT
00116 !| FLUDPTNC       |<->| IMPLICIT DEPOSITION FLUX FOR NON-COHESIVE SEDIMENT
00117 !| FLUER          |<->| EROSION  FLUX FOR EACH 2D POINT
00118 !| GRADZFX        |-->| NOT USED
00119 !| GRADZFY        |-->| NOT USED
00120 !| GRADZSX        |-->| NOT USED
00121 !| GRADZSY        |-->| NOT USED
00122 !| HMIN           |-->| MINIMUM WATER DEPTH TO PREVENT EROSION ON TIDAL FLATS
00123 !| HN             |-->| WATER DEPTH AT TIME N
00124 !| KLOG           |-->| CONVENTION FOR SOLID BOUNDARY
00125 !| LITABF         |-->| FOR BOUNDARY CONDITION BOTTOM
00126 !| LITABS         |<->| FOR BOUNDARY CONDITION SURFACE (NOT USED)
00127 !| MIXTE          |-->| LOGICAL, MIXED SEDIMENTS OR NOT
00128 !| NPLAN          |-->| NUMBER OF PLANES IN THE 3D MESH OF PRISMS
00129 !| NPOIN2         |-->| NUMBER OF 2D POINTS
00130 !| NPOIN3         |-->| NUMBER OF 3D POINTS
00131 !| SEDCO          |-->| LOGICAL FOR COHESIVE SEDIMENT
00132 !| SEDNCO         |-->| LOGICAL, SEDIMENT NON-COHESIVE OR NOT
00133 !| SETDEP         |-->| CHOICE OF CONVECTION SCHEME FOR VERTICAL SETTLING
00134 !| TA             |-->| CONCENTRATION OF SEDIMENTS
00135 !| TOB            |<->| BOTTOM FRICTION
00136 !| TOCD           |-->| CRITICAL SHEAR STRESS FOR SEDIMENT DEPOSITION
00137 !| WC             |-->| SETTLING VELOCITY OF MUD
00138 !| WCS            |-->| SETTLING VELOCITY OF SAND
00139 !| X              |-->| COORDINATE
00140 !| Y              |-->| COORDINATE
00141 !| Z              |-->| COORDINATE
00142 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00143 !
00144       USE BIEF
00145       USE DECLARATIONS_TELEMAC3D, ONLY: IPBOT,SIGMAG,OPTBAN
00146       USE INTERFACE_TELEMAC3D, EX_FLUSED => FLUSED
00147       IMPLICIT NONE
00148       INTEGER LNG,LU
00149       COMMON/INFO/LNG,LU
00150 !
00151 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00152 !
00153       INTEGER, INTENT(IN) :: NPOIN3,NPOIN2,NPLAN,KLOG,SETDEP
00154       LOGICAL, INTENT(IN) :: SEDCO, SEDNCO, MIXTE
00155 !
00156 !     BOTTOM
00157 !     ****
00158 !
00159 !     BY POINTS
00160 !     ----------
00161 !
00162       INTEGER, INTENT(IN) :: LITABF(NPOIN2)
00163 !
00164 !     BY FACES
00165 !     ---------
00166       DOUBLE PRECISION, INTENT(INOUT) :: ATABOF(NPOIN2), BTABOF(NPOIN2)
00167 !
00168 !     FREE SURFACE
00169 !     *******
00170 !
00171 !     BY POINTS
00172 !     ----------
00173 !
00174       INTEGER, INTENT(INOUT) :: LITABS(NPOIN2)
00175 !
00176 !     BY FACES
00177 !     ---------
00178       DOUBLE PRECISION, INTENT(INOUT) :: ATABOS(NPOIN2), BTABOS(NPOIN2)
00179 !
00180 !     OTHER ARRAYS
00181 !
00182       DOUBLE PRECISION, INTENT(IN) :: X(NPOIN3), Y(NPOIN3), Z(NPOIN3)
00183       DOUBLE PRECISION, INTENT(IN) :: TA(NPOIN3)
00184       DOUBLE PRECISION, INTENT(IN) :: WC(NPOIN3)
00185       DOUBLE PRECISION, INTENT(IN) :: GRADZFX(NPOIN2), GRADZFY(NPOIN2)
00186       DOUBLE PRECISION, INTENT(IN) :: GRADZSX(NPOIN2), GRADZSY(NPOIN2)
00187       DOUBLE PRECISION, INTENT(IN) :: HN(NPOIN2)
00188       DOUBLE PRECISION, INTENT(INOUT) :: TOB(NPOIN2)
00189       DOUBLE PRECISION, INTENT(INOUT) :: FLUDPT(NPOIN2), FLUER(NPOIN2)
00190       DOUBLE PRECISION, INTENT(INOUT) :: FLUDPTC(NPOIN2)
00191       DOUBLE PRECISION, INTENT(INOUT) :: FLUDPTNC(NPOIN2)
00192 !
00193       DOUBLE PRECISION, INTENT(IN) :: TOCD
00194       DOUBLE PRECISION, INTENT(IN) :: WCS(NPOIN3)
00195       DOUBLE PRECISION, INTENT(IN) :: HMIN
00196 !
00197 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00198 !
00199       INTEGER I,I3D
00200 !
00201       INTRINSIC MAX
00202 !
00203 !-----------------------------------------------------------------------
00204 !
00205 !     COMPUTES THE DEPOSITION PROBABILITY
00206 !
00207       IF(SEDCO) THEN
00208 !
00209 !       COHESIVE SEDIMENT (Here FLUDPT >0)
00210 !
00211         IF(SIGMAG.OR.OPTBAN.EQ.1) THEN
00212           DO I=1,NPOIN2
00213             IF(IPBOT%I(I).NE.NPLAN-1) THEN
00214 !             DEPOSITION ON THE FIRST FREE PLANE WITH LOCAL VELOCITY
00215               I3D=I+IPBOT%I(I)*NPOIN2
00216               FLUDPT(I) = WC(I3D)*MAX(1.D0-TOB(I)/MAX(TOCD,1.D-6),0.D0)
00217             ELSE
00218 !             TIDAL FLAT
00219               FLUDPT(I) = 0.D0
00220             ENDIF
00221           ENDDO
00222         ELSE
00223           DO I=1,NPOIN2
00224             FLUDPT(I) = WC(I)*MAX(1.D0-(TOB(I)/MAX(TOCD,1.D-6)),0.D0)
00225           ENDDO
00226         ENDIF
00227 !
00228       ENDIF
00229 
00230       IF(SEDNCO) THEN
00231 !
00232 !       NON COHESIVE SEDIMENT
00233 !
00234         IF(SIGMAG.OR.OPTBAN.EQ.1) THEN
00235           DO I=1,NPOIN2
00236             IF(IPBOT%I(I).NE.NPLAN-1) THEN
00237 !             DEPOSITION ON THE FIRST FREE PLANE WITH LOCAL VELOCITY
00238               FLUDPT(I) = WC(I)
00239             ELSE
00240 !             TIDAL FLAT
00241               FLUDPT(I) = 0.D0
00242             ENDIF
00243           ENDDO
00244         ELSE
00245           DO I=1,NPOIN2
00246             FLUDPT(I) = WC(I)
00247           ENDDO
00248         ENDIF
00249 !
00250       ENDIF
00251 
00252       IF(MIXTE) THEN
00253 
00254         IF(SIGMAG.OR.OPTBAN.EQ.1) THEN
00255           DO I=1,NPOIN2
00256             IF(IPBOT%I(I).NE.NPLAN-1) THEN
00257 !             DEPOSITION ON THE FIRST FREE PLANE WITH LOCAL VELOCITY
00258               I3D = I+IPBOT%I(I)*NPOIN2
00259               FLUDPTC(I) = WC(I3D)*MAX(1.D0-TOB(I)/MAX(TOCD,1.D-6),0.D0)
00260               FLUDPTNC(I)= WCS(I)
00261               FLUDPT(I)  = FLUDPTC(I)+FLUDPTNC(I)
00262             ELSE
00263 !             TIDAL FLAT
00264               FLUDPT   = 0.D0
00265               FLUDPTC  = 0.D0
00266               FLUDPTNC = 0.D0
00267             ENDIF
00268           ENDDO
00269         ELSE
00270           DO I=1,NPOIN2
00271             FLUDPTC(I)  = WC(I)*MAX(1.D0-(TOB(I)/MAX(TOCD,1.D-6)),0.D0)
00272             FLUDPTNC(I) = WCS(I)
00273             FLUDPT(I)   = FLUDPTC(I)+FLUDPTNC(I)
00274           ENDDO
00275         ENDIF
00276 !
00277       ENDIF
00278 !
00279 
00280 !-----------------------------------------------------------------------
00281 !
00282 !     COMPUTATION OF THE TRACER FLUX ON THE BOTTOM
00283 !
00284       IF(SETDEP.EQ.1) THEN
00285 !
00286 !       USING HMIN TO CLIP EROSION (DIFFERENT FROM USING IPBOT)
00287         DO I=1,NPOIN2
00288           IF(HN(I).LE.HMIN) THEN
00289             FLUER(I) = 0.D0
00290           ENDIF
00291         ENDDO
00292 !
00293         DO I=1,NPOIN2
00294           IF(LITABF(I).EQ.KLOG) THEN
00295 !           TOM : erosion and deposition are treated with advection
00296             ATABOF(I) = 0.D0
00297             BTABOF(I) = 0.D0
00298           ENDIF
00299         ENDDO
00300 !
00301       ELSEIF(SIGMAG.OR.OPTBAN.EQ.1) THEN
00302 !
00303         DO I=1,NPOIN2
00304           ATABOF(I) = 0.D0
00305           BTABOF(I) = 0.D0
00306           IF(LITABF(I).EQ.KLOG) THEN
00307 !           NO EROSION AND DEPOSITION ON TIDAL FLATS
00308             IF(IPBOT%I(I).NE.NPLAN-1) THEN
00309               ATABOF(I) = -FLUDPT(I)
00310               BTABOF(I) =  FLUER(I)
00311             ENDIF
00312           ENDIF
00313         ENDDO
00314 !
00315       ELSE
00316 !
00317         DO I=1,NPOIN2
00318           IF(LITABF(I).EQ.KLOG) THEN
00319 !           NZ = 1.D0+GRADZFX(I)**2+GRADZFY(I)**2
00320 !           NZ = -1.D0/SQRT(NZ)
00321 !           WC
00322 !           ATABOF(I) = - WC(I) * PDEPOT(I) * NZ
00323 !           BTABOF(I) = - FLUER(I) * NZ
00324 !           JMH: BEWARE, IN DIFF3D NZ IS CONSIDERED AS -1.
00325 !                HENCE WRONG FORMULA BELOW IS ACTUALLY CORRECT
00326             ATABOF(I) = -FLUDPT(I)
00327             BTABOF(I) =  FLUER(I)
00328           ENDIF
00329         ENDDO
00330 !
00331       ENDIF
00332 !
00333 !-----------------------------------------------------------------------
00334 !
00335 !     BOUNDARY CONDITION AT THE FREE SURFACE
00336 !
00337 !     FLUX  = 0 (SETTLING VELOCITY FLUX + DIFFUSIVE FLUX)
00338 !
00339 !     ALREADY DONE IN LIMI3D !!
00340 !
00341 !     DO I=1,NPOIN2
00342 !       ATABOS(I)=0.D0
00343 !       BTABOS(I)=0.D0
00344 !     ENDDO
00345 !
00346 !-----------------------------------------------------------------------
00347 !
00348       RETURN
00349       END

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