suspension_depot.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\suspension_depot.f
00002 !
00075                      SUBROUTINE SUSPENSION_DEPOT  !
00076 !                    ******************************
00077      &(TOB,HN, NPOIN, HMIN,XWC,VITCD,ZERO,KARMAN,
00078      & FDM,FD90,XMVE,T1,T2,ZREF,FLUDPT,DEBUG,SEDCO,CSTAEQ)
00079 !
00080 !***********************************************************************
00081 ! SISYPHE   V6P1                                   21/07/2011
00082 !***********************************************************************
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !
00089 !
00090 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00091 !| DEBUG          |-->| FLAG FOR DEBUGGING
00092 !| FLUDPT         |<->| IMPLICIT DEPOSITION FLUX
00093 !| HMIN           |-->| MINIMUM VALUE OF WATER DEPTH
00094 !| HN             |-->| WATER DEPTH
00095 !| KARMAN         |-->| VON KARMAN CONSTANT
00096 !| NPOIN          |-->| NUMBER OF POINTS
00097 !| SEDCO          |-->| LOGICAL, SEDIMENT COHESIVE OR NOT
00098 !| T1             |<->| WORK BIEF_OBJ STRUCTURE
00099 !| T2             |<->| WORK BIEF_OBJ STRUCTURE
00100 !| TOB            |-->| BED SHEAR STRESS (TOTAL FRICTION)
00101 !| VITCD          |-->| CRITICAL SHEAR VELOCITY FOR MUD DEPOSITION
00102 !| XMVE           |-->| FLUID DENSITY
00103 !| XWC            |-->| SETTLING VELOCITIES
00104 !| ZERO           |-->| ZERO
00105 !| ZREF           |<->| REFERENCE ELEVATION
00106 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00107 !
00108 
00109       USE DECLARATIONS_SISYPHE, ONLY : SET_LAG ! DMK mod
00110       USE INTERFACE_SISYPHE,EX_SUSPENSION_DEPOT => SUSPENSION_DEPOT
00111       USE BIEF
00112       IMPLICIT NONE
00113       INTEGER LNG,LU
00114       COMMON/INFO/LNG,LU
00115 !
00116       ! 2/ GLOBAL VARIABLES
00117       ! -------------------
00118       TYPE (BIEF_OBJ),  INTENT(IN)    ::  HN,TOB,CSTAEQ
00119       INTEGER,          INTENT(IN)    ::  NPOIN,DEBUG
00120       LOGICAL,          INTENT(IN)    :: SEDCO
00121       DOUBLE PRECISION, INTENT(IN)    ::  HMIN
00122       DOUBLE PRECISION, INTENT(IN)    :: FDM,FD90,XWC
00123       DOUBLE PRECISION, INTENT(IN)    :: VITCD
00124       DOUBLE PRECISION, INTENT(IN)    :: ZERO, KARMAN,XMVE
00125       TYPE (BIEF_OBJ),  INTENT(INOUT) :: T1,T2
00126       TYPE (BIEF_OBJ),  INTENT(IN)    :: ZREF
00127       TYPE (BIEF_OBJ),  INTENT(INOUT) :: FLUDPT
00128 !
00129       ! 3/ LOCAL VARIABLES
00130       ! ------------------
00131       INTEGER :: I
00132       DOUBLE PRECISION:: AUX
00133 !======================================================================!
00134 !                               PROGRAM                                !
00135 !======================================================================!
00136 !======================================================================!
00137 !     ! ****************************************            !
00138       ! THE TOTAL FRICTION VELOCITY    --> USTAR (T1)       !
00139       ! HAS BEEN REPLACED BY USTARP (SKIN FRICTION VELOCITY)!
00140       ! FOR EROSION FLUX IN V6P0                            !
00141       ! ****************************************            !
00142 !
00143       CALL OS('X=CY    ', X=T1, Y=TOB, C=1.D0/XMVE)
00144       CALL OS('X=+(Y,C)', X=T1, Y=T1, C=ZERO)
00145       CALL OS('X=SQR(Y)', X=T1, Y=T1)
00146 !
00147       IF(SEDCO) THEN
00148 !
00149       ! ************************************************ !
00150       ! IA - FORMULATION FOR COHESIVE SEDIMENTS          !
00151       !      (WITHOUT BEDLOAD)                           !
00152       ! ************************************************ !
00153 !
00154 !  COMPUTES THE PROBABILITY FOR DEPOSITION
00155 !
00156         DO I = 1, NPOIN
00157           IF(VITCD.GT.1.D-08) THEN
00158             AUX = MAX(1.D0-(T1%R(I)/VITCD)**2,ZERO)
00159           ELSE
00160             AUX=0.D0
00161           ENDIF
00162 !          COMPUTES THE IMPLICIT PART OF THE DEPOSITION FLUX
00163           FLUDPT%R(I)= XWC*AUX
00164         ENDDO
00165 ! UNIFORM SEDIMENT ALONG THE VERTICAL
00166         CALL OS('X=C     ', X=T2, C=1.D0)
00167 !
00168       ! ******************************************* !
00169       ! IB - FORMULATION FOR NON-COHESIVE SEDIMENTS !
00170       !      (WITH BEDLOAD)                         !
00171       ! ******************************************* !
00172 !
00173       ELSE
00174 !
00175             ! ***************************************************** !
00176             !  COMPUTES THE RATIO BETWEEN NEAR BED CONC. AND MEAN CONC.  !
00177             !                                  -->  T2    (TO KEEP )     !
00178             ! ***************************************************** !
00179 !       DMK Modification 06/05/2011
00180 
00181         IF (.NOT.(SET_LAG)) THEN
00182 
00183           IF (DEBUG > 0) WRITE(LU,*) 'SUSPENSION_ROUSE'
00184           CALL SUSPENSION_ROUSE(T1,HN,NPOIN,
00185      &                        KARMAN,HMIN,ZERO,XWC,ZREF,T2)
00186           IF (DEBUG > 0) WRITE(LU,*) 'END SUSPENSION_ROUSE'
00187 !
00188         ELSEIF (SET_LAG) THEN
00189 
00190           IF (DEBUG > 0) WRITE(LU,*) 'SUSPENSION_BETAFACTOR'
00191           CALL SUSPENSION_MILES(HN,NPOIN,KARMAN,HMIN,ZERO,
00192      &                  FDM,FD90,XWC,ZREF,T2)
00193           IF (DEBUG > 0) WRITE(LU,*) 'END SUSPENSION_BETAFACTOR'
00194 
00195         ELSE
00196           PRINT *, 'LAG FACTOR MUST BE EITHER "TRUE" OR "FALSE"'; STOP
00197         ENDIF
00198 
00199 !       End of DMK mod
00200 
00201             ! *****************************************************  !
00202             !  COMPUTES THE DEPOSITION FLUX --> FLUDPT = XWC * T2    !
00203             ! *****************************************************  !
00204 !
00205         CALL OS('X=CY    ', X=FLUDPT, Y=T2, C=XWC)
00206 !
00207       ENDIF
00208 !
00209 !======================================================================!
00210 !======================================================================!
00211 !
00212       RETURN
00213       END

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