init_sediment.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\init_sediment.f
00002 !
00079                      SUBROUTINE INIT_SEDIMENT
00080 !                    ************************
00081 !
00082      &(NSICLA,ELAY,ZF,ZR,NPOIN,AVAIL,FRACSED_GF,AVA0,
00083      & LGRAFED,CALWC,XMVS,XMVE,GRAV,VCE,XWC,FDM,
00084      & CALAC,AC,SEDCO,ES,ES_SABLE, ES_VASE ,NOMBLAY,CONC_VASE,
00085      & MS_SABLE,MS_VASE,ACLADM,UNLADM,TOCE_SABLE,
00086      & CONC,NLAYER,DEBU,MIXTE)
00087 !
00088 !***********************************************************************
00089 ! SISYPHE   V6P2                                   21/07/2011
00090 !***********************************************************************
00091 !
00092 !
00093 !
00094 !
00095 !
00096 !
00097 !
00098 !
00099 !
00100 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00101 !| AC             |<->| CRITICAL SHIELDS PARAMETER
00102 !| ACLADM         |-->| MEAN DIAMETER OF SEDIMENT
00103 !| AT0            |<->| TIME IN S
00104 !| AVAIL          |<->| VOLUME PERCENT OF EACH CLASS
00105 !| CALAC          |-->| IF YES, SHIELDS PARAMETER FOUND IN PARAMETER FILE
00106 !| CALWC          |-->| IF YES, SETTLING VELOCITIES FOUND IN PARAMETER FILE
00107 !| CONC_VASE      |<->| MUD CONCENTRATION FOR EACH LAYER
00108 !| ELAY           |<->| THICKNESS OF SURFACE LAYER
00109 !| ES             |<->| LAYER THICKNESSES AS DOUBLE PRECISION
00110 !| ES_SABLE       |<->| LAYER THICKNESSES OF SAND AS DOUBLE PRECISION
00111 !| ES_VASE        |<->| LAYER THICKNESSES OF MUD AS DOUBLE PRECISION
00112 !| FDM            |-->| DIAMETER DM FOR EACH CLASS
00113 !| FRACSED_GF     |-->|(A SUPPRIMER)
00114 !| GRAV           |-->| ACCELERATION OF GRAVITY
00115 !| LGRAFED        |-->|(A SUPPRIMER)
00116 !| MS_SABLE       |<->| MASS OF SAND PER LAYER (KG/M2)
00117 !| MS_VASE        |<->| MASS OF MUD PER LAYER (KG/M2)
00118 !| ES_SABLE       |<->| THICKNESS OF SAND LAYER (M)
00119 !| ES_VASE        |<->| THICKNESS OF MUD LAYER  (M)
00120 !| MIXTE          |<->| SEDIMENT MIXTE  (SABLE /VASE)
00121 !| NOMBLAY        |-->| NUMBER OF BED LAYERS
00122 !| NPOIN          |-->| NUMBER OF POINTS
00123 !| NSICLA         |-->| NUMBER OF SEDIMENT CLASSES
00124 !| SEDCO          |-->| LOGICAL, SEDIMENT COHESIVE OR NOT
00125 !| UNLADM         |-->| MEAN DIAMETER OF ACTIVE STRATUM LAYER
00126 !| VCE            |-->| WATER VISCOSITY
00127 !| XMVE           |-->| FLUID DENSITY
00128 !| XMVS           |-->| WATER DENSITY
00129 !| XWC            |-->| SETTLING VELOCITY
00130 !| ZF             |-->| ELEVATION OF BOTTOM
00131 !| ZR             |-->| NON ERODABLE BED
00132 !| CONC           |<->| CONCENTRATION OF BED LAYER
00133 !| NLAYER         |<->| NUMBER OF BED LAYER
00134 !| DEBU           |-->| FLAG, RESTART ON SEDIMENTOLOGICAL FILE
00135 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00136 !
00137       USE BIEF
00138       USE INTERFACE_SISYPHE, EX_INIT_SEDIMENT => INIT_SEDIMENT
00139 
00140       IMPLICIT NONE
00141       INTEGER LNG,LU
00142       COMMON/INFO/LNG,LU
00143 !
00144 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00145 !
00146       INTEGER,           INTENT(IN)     :: NSICLA,NPOIN,NOMBLAY
00147       TYPE(BIEF_OBJ),    INTENT(INOUT)  :: ELAY,ZF,ZR
00148       TYPE(BIEF_OBJ), INTENT(INOUT)     :: MS_SABLE, MS_VASE
00149       TYPE(BIEF_OBJ),    INTENT(INOUT)  :: ACLADM, UNLADM
00150       TYPE(BIEF_OBJ),    INTENT(INOUT)  :: NLAYER
00151       LOGICAL,           INTENT(IN)     :: LGRAFED,CALWC
00152       LOGICAL,           INTENT(IN)     :: CALAC
00153       DOUBLE PRECISION,  INTENT(IN)     :: XMVS,XMVE,GRAV,VCE
00154       DOUBLE PRECISION,  INTENT(INOUT)  :: AVA0(NSICLA)
00155       DOUBLE PRECISION,  INTENT(INOUT)  :: AVAIL(NPOIN,NOMBLAY,NSICLA)
00156       DOUBLE PRECISION,  INTENT(INOUT)  :: FRACSED_GF(NSICLA)
00157       DOUBLE PRECISION,  INTENT(INOUT)  :: FDM(NSICLA),XWC(NSICLA)
00158       DOUBLE PRECISION,  INTENT(INOUT)  :: AC(NSICLA),TOCE_SABLE
00159       LOGICAL,           INTENT(IN)     :: SEDCO(NSICLA), DEBU
00160       LOGICAL,           INTENT(IN)     :: MIXTE
00161       DOUBLE PRECISION, INTENT(IN)    :: CONC_VASE(NOMBLAY)
00162       DOUBLE PRECISION, INTENT(INOUT) :: ES(NPOIN,NOMBLAY)
00163       DOUBLE PRECISION, INTENT(INOUT) :: ES_SABLE(NPOIN,NOMBLAY)
00164       DOUBLE PRECISION, INTENT(INOUT) :: ES_VASE(NPOIN,NOMBLAY)
00165       DOUBLE PRECISION, INTENT(INOUT) :: CONC(NPOIN,NOMBLAY)
00166 !
00167 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00168 !
00169       INTEGER            :: I,J
00170       DOUBLE PRECISION   :: DENS,DSTAR
00171 !
00172 !======================================================================!
00173 !======================================================================!
00174 !                               PROGRAM                                !
00175 !======================================================================!
00176 !======================================================================!
00177 !
00178 !  ------ BED COMPOSITION
00179 !
00180       CALL OS('X=Y-Z   ',X=ELAY,Y=ZF,Z=ZR)
00181 !
00182 !     ONLY ONE CLASS
00183 !
00184       IF(NSICLA.EQ.1) THEN
00185         DO I=1,NPOIN
00186           AVAIL(I,1,1) = 1.D0
00187           ACLADM%R(I) = FDM(1)
00188         ENDDO
00189 !       PURE MUD ONLY
00190         IF(SEDCO(1)) CALL INIT_MIXTE(XMVS,NPOIN,AVAIL,NSICLA,ES,
00191      &                               ES_SABLE, ES_VASE,
00192      &                               ELAY%R,NOMBLAY,CONC_VASE,
00193      &                                MS_SABLE%R,MS_VASE%R,ZF%R,
00194      &                               ZR%R,AVA0,CONC,DEBU,.FALSE.)
00195 !
00196       ELSE
00197 !
00198 !     NON-COHESIVE, MULTI-CLASSES
00199 !
00200         IF(.NOT.MIXTE) THEN
00201 !
00202 !
00203           CALL INIT_AVAI
00204 !         CALL MEAN_GRAIN_SIZE
00205 !         THIS PART CAN BE INTEGRATED INTO INIT_AVAI
00206           DO J=1,NPOIN
00207             ACLADM%R(J) = 0.D0
00208             UNLADM%R(J) = 0.D0
00209             DO I=1,NSICLA
00210               IF(AVAIL(J,1,I).GT.0.D0) THEN
00211                 ACLADM%R(J) = ACLADM%R(J) + FDM(I)*AVAIL(J,1,I)
00212                 UNLADM%R(J) = UNLADM%R(J) + FDM(I)*AVAIL(J,2,I)
00213               ENDIF
00214             ENDDO
00215             ACLADM%R(J)=MAX(ACLADM%R(J),0.D0)
00216             UNLADM%R(J)=MAX(UNLADM%R(J),0.D0)
00217           ENDDO
00218         ELSE
00219 !
00220           CALL INIT_MIXTE(XMVS,NPOIN,AVAIL,NSICLA,ES,
00221      &               ES_SABLE, ES_VASE, ELAY%R,
00222      &               NOMBLAY,CONC_VASE,MS_SABLE%R,
00223      &               MS_VASE%R,ZF%R,ZR%R,AVA0,CONC,DEBU,MIXTE)
00224           DO I=1,NPOIN
00225             ACLADM%R(I) = FDM(1)
00226           ENDDO
00227         ENDIF
00228 !
00229       ENDIF
00230 !
00231       IF(LGRAFED) THEN
00232         DO I=1, NSICLA
00233           FRACSED_GF(I)=AVA0(I)
00234         ENDDO
00235       ENDIF
00236 !
00237 !     SETTLING VELOCITY
00238 !
00239       IF(.NOT.CALWC) THEN
00240         DENS = (XMVS - XMVE) / XMVE
00241         DO I = 1, NSICLA
00242           CALL VITCHU_SISYPHE(XWC(I),DENS,FDM(I),GRAV,VCE)
00243         ENDDO
00244       ENDIF
00245 !
00246 !     SHIELDS PARAMETER
00247 !
00248       IF(.NOT.CALAC) THEN
00249         DENS  = (XMVS - XMVE )/ XMVE
00250         DO I = 1, NSICLA
00251           DSTAR = FDM(I)*(GRAV*DENS/VCE**2)**(1.D0/3.D0)
00252           IF (DSTAR <= 4.D0) THEN
00253             AC(I) = 0.24D0/DSTAR
00254           ELSEIF (DSTAR <= 10.D0) THEN
00255             AC(I) = 0.14D0*DSTAR**(-0.64D0)
00256           ELSEIF (DSTAR <= 20.D0) THEN
00257             AC(I) = 0.04D0*DSTAR**(-0.1D0)
00258           ELSEIF (DSTAR <= 150.D0) THEN
00259             AC(I) = 0.013D0*DSTAR**0.29D0
00260           ELSE
00261 !           CORRECTION 30/05/2012
00262 !           AC(I) = 0.055D0
00263             AC(I) = 0.045D0
00264           ENDIF
00265         ENDDO
00266       ENDIF
00267 !
00268 !     FOR MIXED SEDIMENTS
00269 !
00270       IF(MIXTE) TOCE_SABLE=AC(1)*FDM(1)*GRAV*(XMVS - XMVE)
00271 !
00272 !-----------------------------------------------------------------------
00273 !
00274       RETURN
00275       END

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