bedload_hiding_factor.f

Go to the documentation of this file.

!                 ********************************
                  SUBROUTINE bedload_hiding_factor
!                 ********************************
!
     &(acladm, hidfac, npoin, hidi, dm, karim_holly_yang, hiding)
!
!***********************************************************************
! SISYPHE   V6P1                                   21/07/2011
!***********************************************************************
!
!brief    HIDING FACTOR FOR EACH NODE, SEDIMENT CLASS
!+                AND TIME STEP.
!
!history  B. MINH DUC
!+        **/11/2002
!+        V5P3
!+
!
!history  M. GONZALES DE LINARES
!+        **/**/2002
!+        V5P3
!+
!
!history  F. HUVELIN
!+        14/09/2004
!+        V5P5
!+
!
!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
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| ACLADM         |-->| MEAN DIAMETER OF SEDIMENT
!| DM             |-->| SEDIMENT GRAIN DIAMETER
!| HIDFAC         |-->| HIDING FACTOR FORMULAS
!| HIDI           |-->| HIDING FACTOR FOR PARTICULAR SIZE CLASS (HIDFAC =0)
!| HIDING         |-->| HIDING FACTOR CORRECTION
!| NPOIN          |-->| NUMBER OF POINTS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE interface_sisyphe,
     &    ex_bedload_hiding_factor => bedload_hiding_factor
      USE bief
      USE declarations_special
      IMPLICIT NONE
      !
      !
      ! 2/ GLOBAL VARIABLES
      ! -------------------
      !
      TYPE(bief_obj),   INTENT(IN)    :: ACLADM
      INTEGER,          INTENT(IN)    :: HIDFAC, NPOIN
      DOUBLE PRECISION, INTENT(IN)    :: HIDI, DM, KARIM_HOLLY_YANG
      TYPE(bief_obj),   INTENT(INOUT) :: HIDING
      !
      !
      ! 3/ LOCAL VARIABLES
      ! ------------------
      !
      INTEGER          :: J
      DOUBLE PRECISION :: C1, C2
!
!======================================================================!
!======================================================================!
!                               PROGRAM                                !
!======================================================================!
!======================================================================!
!
! *************************** !
! IA - CONSTANT HIDING FACTOR !
! *************************** !
!
      IF (hidfac == 0) THEN
!
        CALL os('X=C     ', x=hiding, c=hidi)
!
! ************************** !
! IB - EGIAZAROFF FORMULATION !
! ************************** !
!
      ELSEIF (hidfac == 1) THEN
!
        c1 = log10(19.d0)
        c2 = 19.d0*dm
        DO j = 1, npoin
          hiding%R(j) = (c1/log10(c2/acladm%R(j)))**2
        ENDDO
!
! ********************************** !
! IC - ASHIDA AND MICHIUE FORMULATION !
! ********************************** !
!
      ELSEIF (hidfac == 2) THEN
!
        c1 = log10(19.d0)
        c2 = 19.d0*dm
        DO j = 1, npoin
!
          IF(dm/acladm%R(j) >= 0.4d0) THEN
            hiding%R(j) = (c1 / log10(c2/acladm%R(j)) )**2
          ELSE
            hiding%R(j) = 0.85d0*(acladm%R(j)/dm)
          ENDIF
!
        ENDDO
!
! ************************************* !
! IE - KARIM, HOLLY AND YANG FORMULATION !
! ************************************* !
!
      ELSEIF (hidfac == 4) THEN
!
        CALL os('X=1/Y   ', x=hiding, y=acladm)
        CALL os('X=CX    ', x=hiding, c=dm)
        CALL os('X=Y**C  ', x=hiding, y=hiding, c=karim_holly_yang)
!
      ELSE
!
        WRITE(lu,*) 'UNKNOWN HIDING FACTOR FORMULA: ',hidfac
        CALL plante(1)
        stop
!
      ENDIF
!
!======================================================================!
!======================================================================!
!
      RETURN
      END SUBROUTINE bedload_hiding_factor