suspension_flux_mixte.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\suspension_flux_mixte.f
00002 !
00074                     SUBROUTINE SUSPENSION_FLUX_MIXTE
00075 !                   ********************************
00076 !
00077      &(TAUP,HN,FDM,NPOIN,CHARR,XMVE,XMVS,VCE,GRAV,HMIN,XWC,
00078      & ZERO,PARTHENIADES,FLUER_SABLE,FLUER_VASE,ZREF,
00079      & AC,CSTAEQ,QSC,ICQ,DEBUG,AVAIL,NSICLA,ES,
00080      & TOCE_VASE,TOCE_SABLE,NOMBLAY,DT,TOCE_MIXTE,MS_SABLE,MS_VASE)
00081 !
00082 !***********************************************************************
00083 ! SISYPHE   V7P0                                   21/07/2011
00084 !***********************************************************************
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !
00091 !
00092 !
00093 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00094 !| AC             |<->| CRITICAL SHIELDS PARAMETER
00095 !| FDM            |-->| DIAMETER DM FOR EACH CLASS
00096 !| AVAIL          |<->| VOLUME PERCENT OF EACH CLASS
00097 !| CHARR          |-->| BEDLOAD
00098 !| CS             |<->| CONCENTRATION AT TIME N
00099 !| CSTAEQ         |<->| EQUILIBRIUM CONCENTRATION
00100 !| DEBUG          |-->| FLAG FOR DEBUGGING
00101 !| DT             |-->| TIME STEP
00102 !| ES             |<->| LAYER THICKNESSES AS DOUBLE PRECISION
00103 !| FLUER_SABLE    |<->| EROSION FLUX FOR MIXED SEDIMENTS
00104 !| FLUER_VASE     |<->| EROSION FLUX FOR MIXED SEDIMENTS
00105 !| GRAV           |-->| ACCELERATION OF GRAVITY
00106 !| HMIN           |-->| MINIMUM VALUE OF WATER DEPTH
00107 !| HN             |-->| WATER DEPTH
00108 !| ICQ            |-->| REFERENCE CONCENTRATION FORMULA
00109 !| MS_SABLE       |<->| MASS OF SAND PER LAYER (KG/M2)
00110 !| MS_VASE        |<->| MASS OF MUD PER LAYER (KG/M2)
00111 !| NOMBLAY        |-->| NUMBER OF LAYERS FOR CONSOLIDATION
00112 !| NPOIN          |-->| NUMBER OF POINTS
00113 !| NSICLA         |-->| NUMBER OF SIZE CLASSES FOR BED MATERIALS
00114 !| PARTHENIADES   |-->| CONSTANT OF THE KRONE AND PARTHENIADES EROSION LAW (KG/M2/S)
00115 !| QSC            |<->| BEDLOAD TRANSPORT RATE
00116 !| TAUP           |-->| CRITICAL SHEAR STRESS
00117 !| TOCE_MIXTE     |<->| CRITICAL SHEAR STRESS FOR MIXED SEDIMENTS
00118 !| TOCE_SABLE     |<->| CRITICAL SHEAR STRESS FOR SAND
00119 !| TOCE_VASE      |<->| CRITICAL EROSION SHEAR STRESS OF THE MUD PER LAYER (N/M2)
00120 !| VCE            |-->| FLOW VISCOSITY
00121 !| XMVE           |-->| FLUID DENSITY
00122 !| XMVS           |-->| WATER DENSITY
00123 !| XWC            |-->| SETTLING VELOCITIES
00124 !| ZERO           |-->| ZERO
00125 !| ZREF           |<->| REFERENCE ELEVATION
00126 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00127 !
00128       USE INTERFACE_SISYPHE, EX_FLUX_MIXTE=>SUSPENSION_FLUX_MIXTE
00129       USE BIEF
00130       USE DECLARATIONS_SISYPHE, ONLY : NLAYMAX
00131 !
00132       IMPLICIT NONE
00133       INTEGER LNG,LU
00134       COMMON/INFO/LNG,LU
00135 !
00136 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00137 !
00138       TYPE (BIEF_OBJ),  INTENT(IN)     :: TAUP,HN
00139       INTEGER,          INTENT(IN)     :: NPOIN,DEBUG,NSICLA
00140       INTEGER,          INTENT(IN)     :: NOMBLAY
00141       LOGICAL,          INTENT(IN)     :: CHARR
00142       DOUBLE PRECISION, INTENT(IN)     :: XMVE, XMVS, VCE,GRAV, HMIN
00143       DOUBLE PRECISION, INTENT(IN)     :: XWC
00144       DOUBLE PRECISION, INTENT(IN)     :: ZERO, PARTHENIADES
00145       TYPE (BIEF_OBJ),  INTENT(IN)     :: ZREF
00146       DOUBLE PRECISION, INTENT(INOUT)  :: AVAIL(NPOIN,NOMBLAY,NSICLA)
00147       DOUBLE PRECISION, INTENT(INOUT)  :: AC
00148       DOUBLE PRECISION, INTENT(INOUT)  :: ES(NPOIN,NOMBLAY)
00149       TYPE (BIEF_OBJ),  INTENT(INOUT)  :: CSTAEQ
00150       TYPE (BIEF_OBJ),  INTENT(INOUT)  :: FLUER_SABLE,FLUER_VASE
00151       DOUBLE PRECISION, INTENT(INOUT)  :: MS_SABLE(NPOIN,NOMBLAY)
00152       DOUBLE PRECISION, INTENT(INOUT)  :: MS_VASE(NPOIN,NOMBLAY)
00153       DOUBLE PRECISION, INTENT(INOUT)  :: TOCE_MIXTE(NPOIN,NOMBLAY)
00154       DOUBLE PRECISION, INTENT(IN)     :: DT, FDM
00155       TYPE(BIEF_OBJ),   INTENT(IN)     ::  QSC
00156       INTEGER,          INTENT (IN)    :: ICQ
00157       DOUBLE PRECISION, INTENT(IN)     :: TOCE_VASE(NOMBLAY)
00158       DOUBLE PRECISION, INTENT(IN)     :: TOCE_SABLE
00159 !
00160 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00161 !
00162       INTEGER I, J
00163       DOUBLE PRECISION FLUERSABLE,FLUERVASE,FLUER_LOC(NLAYMAX)
00164 !
00165       DOUBLE PRECISION QE_MOY,TEMPS,QER_VASE,QER_SABLE
00166       DOUBLE PRECISION F2,DETER
00167 !
00168 !======================================================================!
00169 !======================================================================!
00170 !                               PROGRAM                                !
00171 !======================================================================!
00172 !======================================================================!
00173 !
00174 !     DOES THE EROSION COMPUTATION ONLY ONCE (SAND FOR EXAMPLE
00175 !     BECAUSE THE COMPUTED FLUX IS A GLOBAL FLUX COMMON TO THE 2 SEDIMENTS)
00176 !     COMPUTES THE THEORETICAL FLUX OF EROSION FOR EACH (SEDIMENT INFINITELY
00177 !     AVAILABLE IN EACH LAYER)
00178 !
00179 !     COMPUTES THE CRITICAL STRESS FOR EACH LAYER AS A FUNCTION
00180 !     OF THE PROPORTION OF MUD
00181 !
00182       DO J=1,NOMBLAY
00183         DO I=1,NPOIN
00184 !         PRINT*,'I=',I,' J=',J,' (MS_VASE(I, J)=',MS_VASE(I,J)
00185 !         PRINT*,'I=',I,' J=',J,' (MS_SABLE(I, J)=',MS_SABLE(I,J)
00186           DETER=MS_VASE(I,J) + MS_SABLE(I,J)
00187           IF(DETER.GT.1.D-20) THEN
00188             F2=MS_VASE(I, J)/DETER
00189           ELSE
00190             F2=0.5D0
00191           ENDIF
00192 !         F2= MS_VASE(I, J)/(MS_VASE(I, J) + MS_SABLE(I, J))
00193           IF(F2.LE.0.3D0) THEN
00194             TOCE_MIXTE(I,J)=TOCE_SABLE
00195           ELSEIF(F2.GE.0.5D0)THEN
00196             TOCE_MIXTE(I,J)=TOCE_VASE(J)
00197           ELSE
00198             TOCE_MIXTE(I,J)=TOCE_SABLE +
00199      &   (F2-0.3D0)*(TOCE_VASE(J)-TOCE_SABLE)/(0.5D0-0.3D0)
00200           ENDIF
00201         ENDDO
00202       ENDDO
00203 !
00204       IF(ICQ.EQ.1) THEN
00205         IF(DEBUG > 0) WRITE(LU,*) 'SUSPENSION_FREDSOE'
00206         CALL SUSPENSION_FREDSOE(FDM,TAUP,NPOIN,
00207      &                           GRAV,XMVE,XMVS,ZERO,AC,CSTAEQ)
00208         IF(DEBUG > 0) WRITE(LU,*) 'END SUSPENSION_FREDSOE'
00209 !
00210         DO I=1,NPOIN
00211           CSTAEQ%R(I)=CSTAEQ%R(I)*AVAIL(I,1,1)
00212         ENDDO
00213 !
00214       ELSEIF(ICQ.EQ.2) THEN
00215 !
00216         IF(DEBUG > 0) WRITE(LU,*) 'SUSPENSION_BIJKER'
00217         CALL SUSPENSION_BIJKER(TAUP,HN,NPOIN,CHARR,QSC,ZREF,
00218      &                         ZERO,HMIN,CSTAEQ,XMVE)
00219         IF(DEBUG > 0) WRITE(LU,*) 'END SUSPENSION_BIJKER'
00220 !
00221       ELSEIF(ICQ.EQ.3) THEN
00222         IF(DEBUG > 0) WRITE(LU,*) 'SUSPENSION_VANRIJN'
00223         CALL SUSPENSION_VANRIJN(FDM,TAUP,NPOIN,
00224      &                          GRAV,XMVE,XMVS,VCE,
00225      &                          ZERO,AC,CSTAEQ,ZREF)
00226         IF(DEBUG > 0) WRITE(LU,*) 'END SUSPENSION_VANRIJN'
00227         DO I=1,NPOIN
00228           CSTAEQ%R(I)=CSTAEQ%R(I)*AVAIL(I,1,1)
00229         ENDDO
00230 !
00231       ENDIF
00232 !
00233       DO I=1,NPOIN
00234 !
00235         DO J=1,NOMBLAY
00236 !
00237 !         COMPUTES FLUER_SABLE_VASE AS A FUNCTION OF THE PROPORTION OF MUD
00238 !
00239           DETER=MS_VASE(I,J) + MS_SABLE(I,J)
00240           IF(DETER.GT.1.D-20) THEN
00241             F2=MS_VASE(I, J)/DETER
00242           ELSE
00243             F2=0.5D0
00244           ENDIF
00245 !         F2= MS_VASE(I, J)/(MS_VASE(I, J) + MS_SABLE(I, J))
00246           IF(F2.LE.0.3D0) THEN
00247 !           PROPORTION OF MUD < 30%, FLUXES ARE SIMILAR TO THOSE FOR SAND ONLY
00248             IF(TAUP%R(I).GT.TOCE_MIXTE(I,J))THEN
00249               FLUER_LOC(J)=CSTAEQ%R(I)*XWC
00250             ELSE
00251               FLUER_LOC(J)=0.D0
00252             ENDIF
00253           ELSEIF(F2.GE.0.5D0) THEN
00254 !           PROPORTION OF MUD > 50%, FLUXES ARE SIMILAR TO THOSE FOR MUD ONLY
00255             IF(TAUP%R(I).GT.TOCE_MIXTE(I,J))THEN
00256               FLUER_LOC(J)=PARTHENIADES*
00257      &              ((TAUP%R(I)/TOCE_MIXTE(I,J))-1.D0)
00258             ELSE
00259               FLUER_LOC(J)=0.D0
00260             ENDIF
00261           ELSE
00262 !           PROPORTION OF MUD >30% AND <50%, INTERPOLATES THE FLUXES
00263 !           AND CRITICAL SHEAR STRESS
00264             IF(TAUP%R(I).GT.TOCE_MIXTE(I,J)) THEN
00265               FLUERSABLE=CSTAEQ%R(I)*XWC
00266               FLUERVASE=PARTHENIADES*(TAUP%R(I)/TOCE_MIXTE(I,J)-1.D0)
00267             ELSE
00268               FLUERSABLE=0.D0
00269               FLUERVASE=0.D0
00270             ENDIF
00271               FLUER_LOC(J)=(F2-0.3D0)/
00272      &           (0.5D0-0.3D0)*(FLUERVASE-FLUERSABLE)+FLUERSABLE
00273           ENDIF
00274         ENDDO
00275 !
00276 !       COMPUTES THE EROSION DEPTH ZER_MOY AND ERODED MASSES
00277 !
00278         QER_VASE = 0.D0
00279         QER_SABLE = 0.D0
00280 !
00281         TEMPS= DT
00282 !
00283         DO J= 1, NOMBLAY
00284           IF(ES(I,J).GE.1.D-6) THEN
00285 !           COMPUTES THE MASS POTENTIALLY ERODABLE IN LAYER J (KG/M2)
00286             QE_MOY= FLUER_LOC(J) *XMVS * TEMPS
00287             IF(QE_MOY.LT.MS_SABLE(I,J)+MS_VASE(I,J)) THEN
00288               QER_VASE = QER_VASE
00289      &     +  QE_MOY*MS_VASE(I,J)/(MS_VASE(I,J)+MS_SABLE(I,J))
00290               QER_SABLE = QER_SABLE
00291      &     +  QE_MOY*MS_SABLE(I,J)/(MS_VASE(I,J)+MS_SABLE(I,J))
00292               GO TO 10
00293             ELSE
00294               QER_VASE = QER_VASE + MS_VASE(I,J)
00295               QER_SABLE = QER_SABLE + MS_SABLE(I,J)
00296               TEMPS= TEMPS -
00297      &        (MS_SABLE(I,J)+MS_VASE(I,J))/FLUER_LOC(J)/XMVS
00298             ENDIF
00299           ENDIF
00300         ENDDO
00301         IF(LNG.EQ.1) THEN
00302           WRITE(LU,*) 'ATTENTION TOUTES LES COUCHES SONT VIDES'
00303         ENDIF
00304         IF(LNG.EQ.2) THEN
00305           WRITE(LU,*) 'BEWARE, ALL LAYERS ARE EMPTY'
00306         ENDIF
00307         CALL PLANTE(1)
00308 !       STOP
00309 10      CONTINUE
00310 !
00311 !       Q_VASE REPRESENTS THE SURFACE MASS OF MUD
00312 !       TO BE ERODED TO REACH ZER_MOY
00313 !       Q_SABLE REPRESENTS THE SURFACE MASS OF SAND
00314 !       TO BE ERODED TO REACH ZER_MOY
00315 !
00316         FLUER_VASE%R(I)  = QER_VASE /(DT*XMVS)
00317         FLUER_SABLE%R(I) = QER_SABLE/(DT*XMVS)
00318 !
00319       ENDDO
00320 !
00321 !-----------------------------------------------------------------------
00322 !
00323       RETURN
00324       END

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