bedload_meyer.f

Go to the documentation of this file.

!                   ************************
                    SUBROUTINE bedload_meyer
!                   ************************
!
     &(tetap,hiding,hidfac,dens,grav,dm,ac,acp,qsc,slopeff,coefpn)
!
!***********************************************************************
! SISYPHE   V6P2                                   21/07/2011
!***********************************************************************
!
!brief    MEYER-PETER BEDLOAD TRANSPORT FORMULATION.
!
!history  E. PELTIER; C. LENORMANT; J.-M. HERVOUET
!+        11/09/1995
!+        V5P1
!+
!
!history  C.VILLARET
!+        **/10/2003
!+        V5P4
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!!history  U.MERKEL R.KOPMAN
!+        15/03/2011
!+        V6P1
!+
!
!history  C.VILLARET (EDF-LNHE), P.TASSI (EDF-LNHE)
!+        19/07/2011
!+        V6P1
!+  Name of variables
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| AC             |<->| CRITICAL SHIELDS PARAMETER
!| ACP            |<->| MODIFIED SHIELDS PARAMETER
!| COEFPN         |<->| CORRECTION OF TRANSORT FOR SLOPING BED EFFECT
!| DENS           |-->| RELATIVE DENSITY
!| DM             |-->| SEDIMENT GRAIN DIAMETER
!| GRAV           |-->| ACCELERATION OF GRAVITY
!| HIDFAC         |-->| HIDING FACTOR FORMULAS
!| HIDING         |-->| HIDING FACTOR CORRECTION
!| QSC            |<->| BED LOAD TRANSPORT
!| SLOPEFF        |-->| LOGICAL, SLOPING BED EFFECT OR NOT
!| TETAP          |-->| ADIMENSIONAL SKIN FRICTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE interface_sisyphe, ex_bedload_meyer => bedload_meyer
      USE declarations_sisyphe, ONLY : mpm_aray
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      TYPE(bief_obj),   INTENT(IN)    :: TETAP, HIDING
      INTEGER,          INTENT(IN)    :: HIDFAC, SLOPEFF
      DOUBLE PRECISION, INTENT(IN)    :: DENS, GRAV, DM, AC
      TYPE(bief_obj),   INTENT(INOUT) :: ACP ! WORK ARRAY T1
      TYPE(bief_obj),   INTENT(INOUT) :: QSC, COEFPN
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER I
      DOUBLE PRECISION :: C2
!
!======================================================================!
!                               PROGRAM                                !
!=======================================================================
!
      CALL cpstvc(qsc,acp)
      CALL os('X=C     ', x=acp, c=ac)
!
!     SLOPE EFFECT: SOULBY FORMULATION
!
      IF(slopeff.EQ.2) THEN
        CALL os('X=XY    ', x=acp, y=coefpn )
      ENDIF
!
!     BEDLOAD TRANSPORT CORRECTED FOR EXTENDED GRAIN SIZE
!     WITH VARIABLE MPM_COEFFICIENT
!
      c2 = sqrt(grav*dens*dm**3)
!
      IF(hidfac.EQ.1.OR.hidfac.EQ.2) THEN
!       CALL OS('X=XY    ', X=ACP, Y=HIDING)
!       CALL OS('X=Y-Z   ', X=QSC, Y=TETAP, Z=ACP)
!       CALL OS('X=+(Y,C)', X=QSC, Y=QSC , C=0.D0)
!       CALL OS('X=Y**C  ', X=QSC, Y=QSC , C=1.5D0)
!       CALL OS('X=CX    ', X=QSC, C=C2)
!       CALL OS('X=XY    ', X=QSC, Y=MPM_ARAY)
        DO i=1,qsc%DIM1
          qsc%R(i)=c2*mpm_aray%R(i)
     &               *sqrt(max(tetap%R(i)-acp%R(i)*hiding%R(i),0.d0))**3
        ENDDO
      ELSE
!       CALL OS('X=Y-Z   ', X=QSC, Y=TETAP, Z=ACP)
!       CALL OS('X=+(Y,C)', X=QSC, Y=QSC, C=0.D0)
!       CALL OS('X=Y**C  ', X=QSC, Y=QSC, C=1.5D0)
!       CALL OS('X=CX    ', X=QSC, C=C2)
!       CALL OS('X=XY    ', X=QSC, Y=HIDING)
!       CALL OS('X=XY    ', X=QSC, Y=MPM_ARAY)
        DO i=1,qsc%DIM1
          qsc%R(i)=c2*mpm_aray%R(i)*hiding%R(i)*sqrt(
     &                                 max(tetap%R(i)-acp%R(i),0.d0))**3
        ENDDO
      ENDIF
!
!=======================================================================
!
      RETURN
      END