erode.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\erode.f
00002 !
00064                      SUBROUTINE ERODE
00065 !                    ****************
00066 !
00067      &( IVIDE  , EPAI   ,
00068      &  HDEP   , FLUER  , TOB   , DENSI,
00069      &  NPOIN2 , NPFMAX , NPF   , MPART  ,
00070      &  TOCE   , CFDEP  , RHOS  , DT   , GIBSON)
00071 !
00072 !***********************************************************************
00073 ! TELEMAC3D   V6P1                                   21/08/2010
00074 !***********************************************************************
00075 !
00076 !
00077 !
00078 !
00079 !
00080 !
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !| CFDEP          |-->| CONCENTRATION OF DEPOSIT
00083 !| DENSI          |-->| FLUID DENSITY
00084 !| DT             |-->| TIME STEP
00085 !| EPAI           |<->| THICKNESS OF SOLID BED LAYER
00086 !| FLUER          |<->| EROSION FLUX
00087 !| GIBSON         |-->| LOGICAL FOR SETTLING MODEL
00088 !|                |   | (GIBSON MODEL)
00089 !| HDEP           |<->| THICKNESS OF FRESH DEPOSIT (FLUID MUD LAYER)
00090 !| IVIDE          |<->| VOID RATIO
00091 !| MPART          |-->| EMPIRICAL COEFFICIENT PARTHENIADES
00092 !| NPF            |<->| NUMBER OF POINTS WITHIN THE BED
00093 !| NPFMAX         |-->| MAXIMUM NUMBER OF HORIZONTAL PLANES WITHIN THE BED
00094 !|                |   | (GIBSON MODEL)
00095 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D
00096 !| RHOS           |-->| DENSITY OF  SEDIMENT
00097 !| TOB            |-->| BOTTOM FRICTION
00098 !| TOCE           |-->| CRITICAL  EROSION SHEAR STRENGTH (FRESH DEPOSIT)
00099 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00100 !
00101       USE BIEF
00102       IMPLICIT NONE
00103       INTEGER LNG,LU
00104       COMMON/INFO/LNG,LU
00105 !
00106       INTEGER, INTENT(IN) :: NPOIN2, NPFMAX
00107 !
00108       DOUBLE PRECISION, INTENT(INOUT) :: IVIDE(NPFMAX, NPOIN2)
00109       DOUBLE PRECISION, INTENT(INOUT) :: EPAI(NPFMAX-1, NPOIN2)
00110       DOUBLE PRECISION, INTENT(INOUT) :: HDEP(NPOIN2), FLUER(NPOIN2)
00111       DOUBLE PRECISION, INTENT(IN)    :: TOB(NPOIN2),  DENSI(NPOIN2)
00112 !
00113       DOUBLE PRECISION, INTENT(IN) :: DT, RHOS, CFDEP
00114       DOUBLE PRECISION, INTENT(IN) :: MPART,TOCE
00115 !
00116       INTEGER, INTENT(INOUT) :: NPF(NPOIN2)
00117 !
00118       LOGICAL, INTENT(IN) :: GIBSON
00119 !
00120 !-----------------------------------------------------------------------
00121 !
00122       INTEGER IPOIN, IPF, NERODE, NCOUCH
00123       DOUBLE PRECISION VITCE , TOCEC , QERODE , ECOUCH , TS , QS, TEMPS
00124       INTRINSIC MIN , MAX
00125 !
00126 !-----------------------------------------------------------------------
00127 !     ---- START OF LOOP ON 2D MESH POINTS ----
00128 !
00129 ! JAJ CLUMSY GOTO'S FROM A LOOP AND AN IF-STRUCTURE...
00130 !
00131       DO IPOIN = 1, NPOIN2
00132 !
00133 !      ---- TEMPS: TIME COUNTER FOR EROSION ----
00134 !
00135         TEMPS = DT
00136 !
00137 !      ---- QERODE : ERODED QUANTITY OF SEDIMENT ----
00138 !
00139         QERODE = 0.D0
00140 !
00141 !      ---- NERODE : NUMBER OF ERODED LAYERS ----
00142 !
00143         NERODE = 0
00144 !
00145 !      ---- EROSION OF FRESH DEPOSIT ----
00146 !
00147         IF (HDEP(IPOIN).GE.1.D-10) THEN
00148 !
00149 !         TESTS IF TOB > CRITICAL EROSION FRICTION OF SURFACE LAYER
00150 !
00151           IF ((TOB(IPOIN)-TOCE).LE.1.D-8) GOTO 20
00152 !
00153           FLUER(IPOIN)=MPART*((TOB(IPOIN)/TOCE)-1.D0)
00154           QERODE=MIN(FLUER(IPOIN)*TEMPS,HDEP(IPOIN)*CFDEP)
00155 !
00156 !      ---- REACTUALISES DEPOSIT THICKNESS AFTER EROSION ----
00157 !
00158           HDEP(IPOIN)=
00159      &     MAX(HDEP(IPOIN)-(FLUER(IPOIN)*TEMPS/CFDEP),0.D0)
00160 !
00161 !      ---- TIME LEFT TO ERODE UNDERLAYERS ----
00162 !
00163           TEMPS=TEMPS-QERODE/FLUER(IPOIN)
00164 !
00165         ENDIF
00166 !
00167 !      ---- EROSION OF MUD BED ----
00168 !
00169         IF (GIBSON) THEN
00170           DO IPF=2,NPF(IPOIN)
00171 !
00172 !      ---- NCOUCH: NUMBER OF SUPERFICIAL LAYER ----
00173 !
00174 !         BUG CORRECTED 29/06/2006 AFTER WARNING BY CHC-NRC (THANKS)
00175 !           NCOUCH=-IPF+NPF(NPOIN2)+1
00176             NCOUCH=-IPF+NPF(IPOIN)+1
00177 !
00178             IF (TEMPS.LE.1.D-8) GOTO 20
00179 !
00180 !      ---- CONCENTRATION OF SUPERFICIAL LAYER ----
00181 !
00182             ECOUCH=(IVIDE(NCOUCH,IPOIN)+IVIDE(NCOUCH+1,IPOIN))/2.D0
00183             TS=RHOS/(1.D0+ECOUCH)
00184 !
00185 !      ---- CRITICAL FRICTION VELOCITY AS A FUNCTION OF CONCENTRATION ----
00186 !
00187 !   (EMPIRICAL RELATION, LOIRE ESTUARY, FRITSCH ET AL. 1989 )
00188             IF(TS.LT.240.D0) THEN
00189               VITCE=3.2D-5*(TS**1.175D0)
00190             ELSE
00191               VITCE=5.06D-8*(TS**2.35D0)
00192             ENDIF
00193 !
00194 ! SUPPRESS 4 FOLLOWING LINES TO ACTIVATE THE SUBROUTINE
00195 !
00196             WRITE(LU,*)
00197             IF (LNG.EQ.1) WRITE(LU,11)
00198             IF (LNG.EQ.2) WRITE(LU,12)
00199             CALL PLANTE(1)
00200             STOP
00201 !
00202 11          FORMAT(
00203 'SOUS-PROGRAMME ERODE : DONNER LA VITESSE     &             CRITIQUE',/,
00204      &             'D'
00205 'EROSION DU LIT CONSOLIDE FONCTION DE LA     &             CONCENTRATION')
00206 12          FORMAT(
00207 'SUBROUTINE ERODE : EXPRESS THE CRITICAL     &             SHEAR STRESS FOR',
00208      &             /, 
00209 'EROSION (CONSOLIDATED BED) FUNCTION OF     &             THE CONCENTRATION')
00210 !
00211 !-----------------------------------------------------------------------
00212 !
00213 !        ---- COMPUTES THE CRITICAL BED SHEAR STRENGTH FOR EROSION
00214 !                          FOR CONSOLIDATED BED , TOCEC
00215             TOCEC=DENSI(IPOIN)*VITCE**2
00216 !
00217 !        ---- EROSION FLUX
00218 !
00219             FLUER(IPOIN)=MPART*MAX((TOB(IPOIN)/TOCEC)-1.D0,0.D0)
00220 !
00221 !        ---- MAXIMAL AMOUNT OF SEDIMENT AVAILABLE FOR EROSION
00222 !
00223             QS=RHOS*EPAI(NCOUCH,IPOIN)
00224 !
00225             IF ((FLUER(IPOIN)*TEMPS).GE.QS) THEN
00226 !
00227 !        ---- EROSION OF THE WHOLE BED LAYER
00228 !
00229               EPAI(NCOUCH,IPOIN)=0.D0
00230 !
00231 !        ---- ERODED QUANTITY
00232 !
00233               QERODE=QERODE+QS
00234 !
00235 !        ---- TIME LEFT AFTER EROSION OF LAYER
00236 !
00237               TEMPS=TEMPS-(QS/FLUER(IPOIN))
00238 !
00239 !        ---- NUMBER OF ERODED LAYERS
00240 !
00241               NERODE=NERODE+1
00242 !
00243             ELSE
00244 !
00245 !        ---- PARTIAL EROSION OF BED LAYER
00246 !
00247               EPAI(NCOUCH,IPOIN)=EPAI(NCOUCH,IPOIN)-
00248      &                                      (FLUER(IPOIN)*TEMPS/RHOS)
00249 !
00250 !        ---- ERODED QUANTITY
00251 !
00252               QERODE=QERODE+(FLUER(IPOIN)*TEMPS)
00253 !
00254               GOTO 20
00255 !
00256             ENDIF
00257           ENDDO
00258         ENDIF
00259 !
00260 20      CONTINUE
00261 ! GOTO TARGET
00262 !
00263 !     ----- END OF EROSION STEP -----
00264 !
00265         FLUER(IPOIN)=QERODE/DT
00266         NPF(IPOIN)=NPF(IPOIN)-NERODE
00267 !
00268       ENDDO
00269 !
00270 !-----------------------------------------------------------------------
00271 !
00272       RETURN
00273       END SUBROUTINE ERODE

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