bedload_engel_cc.f

Go to the documentation of this file.

!                   ***************************
                    SUBROUTINE bedload_engel_cc
!                   ***************************
!
     &(tetap,cf,npoin,grav,dm,dens,teta,qsc)
!
!***********************************************************************
! SISYPHE   V7P3                                   10/01/2018
!***********************************************************************
!
!brief    ENGELUND-HANSEN BEDLOAD TRANSPORT FORMULATION.
!
!warning  FORMULATION IS DIFFERENT FROM THAT IN BEDLOAD_ENGEL
!
!history  E. PELTIER; C. LENORMANT; J.-M. HERVOUET
!+        11/09/1995
!+        V5P1
!+
!
!history  C.VILLARET
!+        **/11/2003
!+        V5P4
!+
!
!history  J-M HERVOUET
!+        11/07/2007
!+        V5P8
!+   DELETED OS REFERENCES
!
!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  C.VILLARET (EDF-LNHE), P.TASSI (EDF-LNHE)
!+        19/07/2011
!+        V6P1
!+  Name of variables
!+
!history  P.TASSI (EDF-LNHE)
!+        10/01/2018
!+        V7P3
!+ Correction of the coefficient of the Engelund and Hansen formula
!+ (thanks to Alexander Breugem)
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| CF             |-->| QUADRATIC FRICTION COEFFICIENT
!| DENS           |-->| RELATIVE DENSITY
!| DM             |-->| SEDIMENT GRAIN DIAMETER
!| GRAV           |-->| ACCELERATION OF GRAVITY
!| NPOIN          |-->| NUMBER OF POINTS
!| QSC            |<->| BED LOAD TRANSPORT
!| TETA           |<->| DIMENSIONLESS BED SHEAR STRESS
!| TETAP          |-->| ADIMENSIONAL SKIN FRICTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE interface_sisyphe,ex_bedload_engel_cc => bedload_engel_cc
      USE bief
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      TYPE(bief_obj),   INTENT(IN)    :: TETAP,CF
      INTEGER,          INTENT(IN)    :: NPOIN
      DOUBLE PRECISION, INTENT(IN)    :: GRAV, DM, DENS
      TYPE(bief_obj),   INTENT(INOUT) :: TETA! WORK ARRAY T1
      TYPE(bief_obj),   INTENT(INOUT) :: QSC
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER          :: I
      DOUBLE PRECISION :: CENGEL
!
      INTRINSIC sqrt
!
!======================================================================!
!======================================================================!
!                               PROGRAM                                !
!======================================================================!
!======================================================================!
!
!     ADIMENSIONAL SKIN STRESS: TETAP
!
!     ADIMENSIONAL TOTAL STRESS
!
      DO i = 1, npoin
        IF(tetap%R(i) <= 0.06d0) THEN
          teta%R(i) = 0.d0
        ELSEIF(tetap%R(i) <  0.384d0) THEN
          teta%R(i) = sqrt( 2.5d0 * (tetap%R(i) - 0.06d0))
        ELSEIF(tetap%R(i) <  1.080d0) THEN
          teta%R(i) = 1.066d0 * tetap%R(i)**0.176d0
        ELSE
          teta%R(i) = tetap%R(i)
        ENDIF
      ENDDO
!
!     BEDLOAD TRANSPORT
!
      cengel = 0.05d0*sqrt(dens*grav*dm**3)
      DO i=1,npoin
        qsc%R(i)=cengel*sqrt(teta%R(i)**5)/max(cf%R(i),1.d-6)
      ENDDO
!
!-----------------------------------------------------------------------
!
      RETURN
      END