erodc.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\erodc.f
00002 !
00074                      SUBROUTINE ERODC
00075 !                    ****************
00076 !
00077      &( CONC  , EPAI   , FLUER  , TOB    , DENSI  ,
00078      &  MPART , DT     , NPOIN2 , NCOUCH ,TOCE, HN, HMIN,
00079      &  MIXTE, EPAICO)
00080 !
00081 !***********************************************************************
00082 ! TELEMAC3D   V7P0                                   21/08/2010
00083 !***********************************************************************
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !
00091 !
00092 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00093 !| CONC           |-->| CONCENTRATION OF BED LAYER
00094 !| DENSI          |-->| FLUID DENSITY
00095 !| DT             |-->| TIME STEP
00096 !| EPAI           |<->| THICKNESS OF SOLID BED LAYER
00097 !|                |   | (EPAI=DZ/(1+IVIDE), DZ total bed thickness)
00098 !| EPAICO         |-->| THICKNESS OF COHESIVE SUB-LAYER
00099 !| FLUER          |<->| EROSION  FLUX
00100 !| HN             |-->| DEPTH AT TIME N
00101 !| HMIN           |-->| MINIMAL VALUE FOR DEPTH
00102 !| MIXTE          |-->| LOGICAL, MIXED SEDIMENTS OR NOT
00103 !| MPART          |-->| EMPIRICAL COEFFICIENT (PARTHENIADES)
00104 !| NCOUCH         |-->| NUMBER OF LAYERS WITHIN THE BED
00105 !|                |   | (GIBSON MODEL)
00106 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D
00107 !| TOB            |-->| BOTTOM FRICTION
00108 !| TOCE           |-->| CRITICAL EROSION SHEAR STRESS
00109 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00110 !
00111       USE BIEF
00112       USE INTERFACE_TELEMAC3D, EX_ERODC => ERODC
00113       IMPLICIT NONE
00114       INTEGER LNG,LU
00115       COMMON/INFO/LNG,LU
00116 !
00117 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00118 !
00119       INTEGER, INTENT(IN) :: NPOIN2, NCOUCH
00120 !
00121       DOUBLE PRECISION, INTENT(IN)    :: CONC(NPOIN2,NCOUCH), HN(NPOIN2)
00122       DOUBLE PRECISION, INTENT(IN)    :: TOCE(NPOIN2,NCOUCH)
00123       DOUBLE PRECISION, INTENT(INOUT) :: EPAI(NPOIN2,NCOUCH)
00124       DOUBLE PRECISION, INTENT(IN)    :: EPAICO(NPOIN2)
00125       DOUBLE PRECISION, INTENT(INOUT) :: FLUER(NPOIN2)
00126       DOUBLE PRECISION, INTENT(IN)    :: TOB(NPOIN2),DENSI(NPOIN2)
00127       LOGICAL, INTENT(IN)             :: MIXTE
00128       DOUBLE PRECISION, INTENT(IN)    :: MPART, DT, HMIN
00129 !
00130 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00131 !
00132       INTEGER IC, IPOIN
00133       DOUBLE PRECISION   QS, TEMPS , QERODE
00134       INTRINSIC MIN , MAX
00135 !
00136       DOUBLE PRECISION FLUER_LOC
00137 !
00138 !-----------------------------------------------------------------------
00139 !
00140 !
00141 !CV UNIFORM BED
00142 !
00143 !      IF(NCOUCH.EQ.1) THEN
00144 !
00145 !        DO IPOIN=1,NPOIN2
00146 !
00147 !          FLUER(IPOIN) = 0.D0
00148 !          IF (HN(IPOIN)<HMIN) THEN
00149 !             GOTO 10
00150 !          ENDIF
00151 !
00152 !         TESTS IF TOB > CRITICAL EROSION FRICTION OF SURFACE LAYER
00153 !
00154 !          IF ((TOB(IPOIN)-TOCE(IPOIN,1)).GE.1.D-8) THEN
00155 !
00156 !            FLUER(IPOIN)=MPART*((TOB(IPOIN)/TOCE(IPOIN,1))-1.D0)
00157 !            FLUER(IPOIN)=MIN(FLUER(IPOIN),
00158 !     &               EPAI(IPOIN,1)*CONC(IPOIN,1)/DT)
00159 !
00160 !          ENDIF
00161 !10      CONTINUE
00162 !        ENDDO
00163 !
00164 !      ELSE
00165 !CV
00166 !     ---- TEMPS:TIME COUNTER FOR EROSION ----
00167 !
00168       IF(MIXTE) THEN
00169 
00170         DO IPOIN=1,NPOIN2
00171 !
00172         FLUER(IPOIN) = 0.D0
00173         IF(HN(IPOIN).LT.HMIN) GOTO 50
00174 !
00175 ! initialisation
00176           TEMPS=DT
00177           QERODE=0.D0
00178 !
00179             IF (TEMPS.LE.1.D-12) GO TO 40
00180 !
00181 !     ---- EROSION OF TOP LAYER IF TOB > CRITICAL SHEAR STRESS ----
00182 
00183             IF (TOB(IPOIN).GT.TOCE(IPOIN,1)) THEN
00184 !
00185               FLUER_LOC=MPART*((TOB(IPOIN)/
00186      &        MAX(TOCE(IPOIN,1),1.D-10))-1.D0)
00187               QS=CONC(IPOIN,1)*EPAICO(IPOIN)
00188 !CV ...
00189 !    ---- LAYER THICKNESS AFTER EROSION ----
00190 !
00191 !            EPAI(IC,IPOIN)=MAX(0.D0,EPAI(IC,IPOIN)-
00192 !     &                             (FLUER(IPOIN)*TEMPS/CONC(IC)))
00193 !
00194 ! ...CV : done in fonvas
00195 !
00196               QS=MIN(FLUER_LOC*TEMPS,CONC(IPOIN,1)*EPAICO(IPOIN))
00197               QERODE=QERODE+QS
00198               TEMPS= TEMPS-(QS/MAX(FLUER_LOC,1.D-10))
00199 
00200             ENDIF
00201 !
00202 40      CONTINUE
00203 !     -----END OF THE EROSION STEP-----
00204 !
00205         FLUER(IPOIN)=QERODE/DT
00206 !
00207 50      CONTINUE
00208       ENDDO
00209 
00210       ELSE
00211 
00212       DO IPOIN=1,NPOIN2
00213 !
00214         FLUER(IPOIN) = 0.D0
00215         IF(HN(IPOIN).LT.HMIN) GOTO 30
00216 !
00217 ! initialisation
00218           TEMPS=DT
00219           QERODE=0.D0
00220 !
00221           DO IC=1, NCOUCH
00222 !
00223             IF (TEMPS.LE.1.D-12) GO TO 20
00224 !
00225 !     ---- EROSION OF TOP LAYER IF TOB > CRITICAL SHEAR STRESS ----
00226 
00227             IF (TOB(IPOIN).GT.TOCE(IPOIN,IC)) THEN
00228 !
00229               FLUER_LOC=MPART*((TOB(IPOIN)
00230      &        /MAX(TOCE(IPOIN,IC),1.D-10))-1.D0)
00231               QS=CONC(IPOIN,IC)*EPAI(IPOIN,IC)
00232 !CV ...
00233 !    ---- LAYER THICKNESS AFTER EROSION ----
00234 !
00235 !            EPAI(IC,IPOIN)=MAX(0.D0,EPAI(IC,IPOIN)-
00236 !     &                             (FLUER(IPOIN)*TEMPS/CONC(IC)))
00237 !
00238 ! ...CV : done in fonvas
00239 !
00240               QS=MIN(FLUER_LOC*TEMPS,CONC(IPOIN,IC)*EPAI(IPOIN,IC))
00241               QERODE=QERODE+QS
00242               TEMPS= TEMPS-(QS/FLUER_LOC)
00243 
00244             ENDIF
00245 !
00246 
00247           ENDDO
00248 !
00249 20      CONTINUE
00250 !
00251 !     -----END OF THE EROSION STEP-----
00252 !
00253         FLUER(IPOIN)=QERODE/DT
00254 !
00255 30      CONTINUE
00256 !
00257       ENDDO
00258 
00259       ENDIF
00260 !
00261       RETURN
00262       END

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