bedload_wilcock_crowe.f

Go to the documentation of this file.

!                   ************************
                    SUBROUTINE bedload_wilcock_crowe
!                   ************************
!
     &(tob, mu, acladm, dm, ava, grav, xmve, xmvs, sanfra, qsc, ac, acp,
     & slopeff,coefpn)
!
!***********************************************************************
! SISYPHE   V8P0                                   16/09/2018
!***********************************************************************
!
!brief    WILCOCK AND CROWE NON-UNIFORM TRANSPORT FORMULATION.
!
!history  F.CORDIER & P. TASSI (EDF-LNHE)
!+        16/09/2018
!+        V8P0
!+  Implementation of the Wilcock and Crowe formula
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| AC             |<->| CRITICAL SHIELDS PARAMETER
!| ACP            |<->| MODIFIED SHIELDS PARAMETER
!| COEB           |-->| POWER COEFF OF THE HIDING-EXPOSURE FUNCTION
!| COEFPN         |<->| CORRECTION OF TRANSORT FOR SLOPING BED EFFECT
!| DENS           |-->| RELATIVE DENSITY
!| DM             |-->| SEDIMENT GRAIN DIAMETER
!| GRAV           |-->| ACCELERATION OF GRAVITY
!| QSC            |<->| BED LOAD TRANSPORT
!| SANFRA         |-->| SAND FRACTION
!| SLOPEFF        |-->| LOGICAL, SLOPING BED EFFECT OR NOT
!| TETAP          |-->| ADIMENSIONAL SKIN FRICTION
!| TORATIO        |-->| RATIO BETWEEN BED SHEAR STRESS AND TORI
!| TORI           |-->| REFERENCE SHEAR STRESS OF THE I-TH SIZE SEDIMENT
!| TORM           |-->| REFERENCE SHEAR STRESS OF THE MEDIAN SEDIMENT
!| WI             |-->| DIMENSIONLESS TRANSPORT RATE OF WC-2003
!| WCC            |-->| COEFFICIENT OF CALIBRATION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE interface_sisyphe,
     &      ex_bedload_wilcock_crowe => bedload_wilcock_crowe
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER,          INTENT(IN)    :: SLOPEFF
      TYPE(bief_obj),   INTENT(INOUT) :: QSC, COEFPN
      DOUBLE PRECISION, INTENT(IN)    :: XMVE, XMVS, GRAV, DM, AC,
     &                                   ava(qsc%DIM1)
      DOUBLE PRECISION, INTENT(IN)    :: SANFRA(qsc%dim1)
      TYPE(bief_obj),   INTENT(INOUT) :: ACP ! WORK ARRAY T1
      TYPE(bief_obj),   INTENT(IN)    :: ACLADM
      TYPE(bief_obj),   INTENT(IN)    :: TOB, MU
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER I
      DOUBLE PRECISION TORM, TORI, TORATIO, WI, COEFB, WCC
!
!======================================================================!
!                               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
!
!     COEFFICIENT TO CALIBRATE THE FORMULA (by default = 1.0)
      wcc = 1.0d0
!
      DO i=1,qsc%DIM1
        torm = (0.021d0 + 0.015d0*exp(-20.d0*sanfra(i)))*
     &       (xmvs/xmve-1.d0)*xmve*grav*acladm%R(i)
        coefb = 0.67d0/(1.0d0+exp(1.5d0-dm/acladm%R(i)))
        tori = torm*((dm/acladm%R(i))**coefb)
        toratio = tob%R(i)*mu%R(i)/tori
        IF (toratio.LT.1.35d0) THEN
          wi = 2.d-3*(toratio**7.5d0)
        ELSE
          wi = 14.d0*((1.d0-0.894d0/sqrt(toratio))**4.5d0)
        ENDIF
        qsc%R(i)=wcc*wi*ava(i)*((tob%R(i)*mu%R(i)
     &  /xmve)**1.5d0)/((xmvs/xmve-1.d0)*grav)

!       IF VERY LOW TRANSPORT WE IMPOSE QB = 0 (TO AVOID NUMERICAL
!       ARTIFACTS)
        IF (qsc%R(i).LT.1.d-13) THEN
          qsc%R(i)=0.0d0
        ENDIF
      ENDDO
!
!=======================================================================
!
      RETURN
      END
!