bedload_bijker.f

Go to the documentation of this file.

!                   *************************
                    SUBROUTINE bedload_bijker
!                   *************************
!
     &  (tobw,tob,mu,ksp,ksr,hn,npoin,dm,dens,xmve,grav,xwc,
     &   karman,zero,t4,t7,t8,t9,qsc,qss,bijk,houle)
!
!***********************************************************************
! SISYPHE   V6P1                                   21/07/2011
!***********************************************************************
!
!brief    BIJKER BEDLOAD TRANSPORT FORMULATION.
!
!history  C. MACHET; T. BOULET; E. BEN SLAMA
!+        26/11/2001
!+        V5P1
!+
!
!history  C. VILLARET
!+        10/03/2004
!+        V5P4
!+
!
!history  F. HUVELIN
!+        **/12/2004
!+        V5P6
!+
!
!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
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| BIJK           |-->| COEFFICIENT OF THE BIJKER FORMULA
!| DENS           |-->| RELATIVE DENSITY
!| DM             |-->| SEDIMENT GRAIN DIAMETER
!| GRAV           |-->| ACCELERATION OF GRAVITY
!| HN             |-->| WATER DEPTH
!| HOULE          |-->| LOGICAL, FOR WAVE EFFECTS
!| KARMAN         |-->| VON KARMAN CONSTANT
!| KSP            |-->| BED SKIN ROUGHNESS
!| KSR            |-->| RIPPLE BED ROUGHNESS
!| MU             |<->| CORRECTION FACTOR FOR BED ROUGHNESS
!| NPOIN          |-->| NUMBER OF POINTS
!| QSC            |<->| BED LOAD TRANSPORT
!| QSS            |<->| SUSPENDED LOAD TRANSPORT
!| T4             |<->| WORK BIEF_OBJ STRUCTURE
!| T7             |<->| WORK BIEF_OBJ STRUCTURE
!| T8             |<->| WORK BIEF_OBJ STRUCTURE
!| T9             |<->| WORK BIEF_OBJ STRUCTURE
!| TOB            |<->| BED SHEAR STRESS (TOTAL FRICTION)
!| TOBW           |-->| WAVE INDUCED SHEAR STRESS
!| XMVE           |-->| FLUID DENSITY
!| XWC            |-->| SETTLING VELOCITY
!| ZERO           |-->| ZERO
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE interface_sisyphe,ex_bedload_bijker => bedload_bijker
      USE bief
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      TYPE(bief_obj),   INTENT(IN)    :: TOBW, TOB, KSR,KSP, HN,MU
      INTEGER,          INTENT(IN)    :: NPOIN
      LOGICAL,          INTENT(IN)    :: HOULE
      DOUBLE PRECISION, INTENT(IN)    :: DM, DENS, XMVE, GRAV, XWC
      DOUBLE PRECISION, INTENT(IN)    :: KARMAN, ZERO
      TYPE(bief_obj),   INTENT(INOUT) :: T4
      TYPE(bief_obj),   INTENT(INOUT) :: T7, T8, T9
      TYPE(bief_obj),   INTENT(INOUT)   :: QSC, QSS
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER                      :: I
      DOUBLE PRECISION             :: C1, C2, UCF
      DOUBLE PRECISION, INTENT(IN) :: BIJK
!
!======================================================================!
!======================================================================!
!                               PROGRAM                                !
!======================================================================!
!======================================================================!
!
      ! ***************************************************** !
      ! I - STRESS UNDER THE COMBINED ACTION OF WAVES AND CURRENTS !
      ! ***************************************************** !
      IF(houle) THEN
        CALL os('X=CY    ', x=t4, y=tobw, c= 0.5d0)
        CALL os('X=X+Y   ', x=t4, y=tob)
      ELSE
        CALL os('X=Y     ', x=t4, y=tob)
      ENDIF
      ! ******************************************************* !
      ! II - CORRECTION TO TAKE BED FORMS INTO ACCOUNT          !
      ! ******************************************************* !
!      CALL OS('X=Y/Z   ', X=MU, Y=CFP, Z=CF)
!      CALL OS('X=Y**C  ', X=MU, Y=MU , C=0.75D0)
      ! ***************************** !
      ! III - BEDLOAD TRANSPORT       !
      ! ***************************** !
      c1 = bijk*dm
      c2 = dens*dm*xmve*grav
      DO i = 1, npoin
        IF (t4%R(i)*mu%R(i)> zero) THEN
          qsc%R(i) = c1*sqrt(tob%R(i)/xmve )
     &             * exp(-0.27d0*(c2/(t4%R(i)*mu%R(i))))
        ELSE
          qsc%R(i) = 0.d0
        ENDIF
      ENDDO
      ! *********************************************************** !
      ! IV- ROUSE NUMBER AND LOWER BOUND OF EINSTEIN INTEGRAL       !
      ! *********************************************************** !
      DO i = 1, npoin
        IF (t4%R(i) > 0.d0) THEN
          ucf     = sqrt( t4%R(i) / xmve)
          t7%R(i) = xwc / ( karman * ucf )
!         AUX     = 1.D0 + KARMAN*SQRT(2.D0/MAX(CF%R(I),ZERO))
!         T8%R(I) = 30.D0*EXP(-AUX)
          t8%R(i) = max(ksr%R(i),ksp%R(i))/max(hn%R(i),zero)
        ELSE
          t7%R(i)= 100001.d0
          t8%R(i)= 100001.d0
        ENDIF
      ENDDO
      ! ************************************ !
      ! V - EINSTEIN INTEGRAL                !
      ! ************************************ !
      CALL integ(t7%R, t8%R, t9%R, npoin)
      ! ************************************** !
      ! VI - TRANSPORT BY SUSPENSION           !
      ! ************************************** !
      CALL os('X=YZ    ', x=qss, y=t9, z=qsc)
!======================================================================!
!======================================================================!
      RETURN
      END SUBROUTINE bedload_bijker