bedload_meyer.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\sisyphe\bedload_meyer.f
00002 !
00074                      SUBROUTINE BEDLOAD_MEYER
00075 !                    ************************
00076 !
00077      &(TETAP,HIDING,HIDFAC,DENS,GRAV,DM,AC,ACP,QSC,SLOPEFF,COEFPN)
00078 !
00079 !***********************************************************************
00080 ! SISYPHE   V6P2                                   21/07/2011
00081 !***********************************************************************
00082 !
00083 !
00084 !
00085 !
00086 !
00087 !
00088 !!history  U.MERKEL R.KOPMAN
00089 !+        15/03/2011
00090 !+        V6P1
00091 !+
00092 !
00093 !
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !| AC             |<->| CRITICAL SHIELDS PARAMETER
00096 !| ACP            |<->| MODIFIED SHIELDS PARAMETER
00097 !| COEFPN         |<->| CORRECTION OF TRANSORT FOR SLOPING BED EFFECT
00098 !| DENS           |-->| RELATIVE DENSITY
00099 !| DM             |-->| SEDIMENT GRAIN DIAMETER
00100 !| GRAV           |-->| ACCELERATION OF GRAVITY
00101 !| HIDFAC         |-->| HIDING FACTOR FORMULAS
00102 !| HIDING         |-->| HIDING FACTOR CORRECTION
00103 !| QSC            |<->| BED LOAD TRANSPORT
00104 !| SLOPEFF        |-->| LOGICAL, SLOPING BED EFFECT OR NOT
00105 !| TETAP          |-->| ADIMENSIONAL SKIN FRICTION
00106 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00107 !
00108       USE BIEF
00109       USE INTERFACE_SISYPHE, EX_BEDLOAD_MEYER => BEDLOAD_MEYER
00110       USE DECLARATIONS_SISYPHE, ONLY : MPM_ARAY
00111       IMPLICIT NONE
00112       INTEGER LNG,LU
00113       COMMON/INFO/LNG,LU
00114 !
00115 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00116 !
00117       TYPE(BIEF_OBJ),   INTENT(IN)    :: TETAP, HIDING
00118       INTEGER,          INTENT(IN)    :: HIDFAC, SLOPEFF
00119       DOUBLE PRECISION, INTENT(IN)    :: DENS, GRAV, DM, AC
00120       TYPE(BIEF_OBJ),   INTENT(INOUT) :: ACP ! WORK ARRAY T1
00121       TYPE(BIEF_OBJ),   INTENT(INOUT) :: QSC, COEFPN
00122 !
00123 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00124 !
00125       INTEGER I
00126       DOUBLE PRECISION :: C2
00127 !
00128 !======================================================================!
00129 !                               PROGRAM                                !
00130 !=======================================================================
00131 !
00132       CALL CPSTVC(QSC,ACP)
00133       CALL OS('X=C     ', X=ACP, C=AC)
00134 !
00135 !     SLOPE EFFECT: SOULBY FORMULATION
00136 !
00137       IF(SLOPEFF.EQ.2) THEN
00138         CALL OS('X=XY    ', X=ACP, Y=COEFPN )
00139       ENDIF
00140 !
00141 !     BEDLOAD TRANSPORT CORRECTED FOR EXTENDED GRAIN SIZE
00142 !     WITH VARIABLE MPM_COEFFICIENT
00143 !
00144       C2 = SQRT(GRAV*DENS*DM**3)
00145 !
00146       IF(HIDFAC.EQ.1.OR.HIDFAC.EQ.2) THEN
00147 !       CALL OS('X=XY    ', X=ACP, Y=HIDING)
00148 !       CALL OS('X=Y-Z   ', X=QSC, Y=TETAP, Z=ACP)
00149 !       CALL OS('X=+(Y,C)', X=QSC, Y=QSC , C=0.D0)
00150 !       CALL OS('X=Y**C  ', X=QSC, Y=QSC , C=1.5D0)
00151 !       CALL OS('X=CX    ', X=QSC, C=C2)
00152 !       CALL OS('X=XY    ', X=QSC, Y=MPM_ARAY)
00153         DO I=1,QSC%DIM1
00154           QSC%R(I)=C2*MPM_ARAY%R(I)
00155      &               *SQRT(MAX(TETAP%R(I)-ACP%R(I)*HIDING%R(I),0.D0))**3
00156         ENDDO
00157       ELSE
00158 !       CALL OS('X=Y-Z   ', X=QSC, Y=TETAP, Z=ACP)
00159 !       CALL OS('X=+(Y,C)', X=QSC, Y=QSC, C=0.D0)
00160 !       CALL OS('X=Y**C  ', X=QSC, Y=QSC, C=1.5D0)
00161 !       CALL OS('X=CX    ', X=QSC, C=C2)
00162 !       CALL OS('X=XY    ', X=QSC, Y=HIDING)
00163 !       CALL OS('X=XY    ', X=QSC, Y=MPM_ARAY)
00164         DO I=1,QSC%DIM1
00165           QSC%R(I)=C2*MPM_ARAY%R(I)*HIDING%R(I)*SQRT(
00166      &                                 MAX(TETAP%R(I)-ACP%R(I),0.D0))**3
00167         ENDDO
00168       ENDIF
00169 !
00170 !=======================================================================
00171 !
00172       RETURN
00173       END

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