bedload_solidischarge.f

Go to the documentation of this file.

!                   ********************************
                    SUBROUTINE bedload_solidischarge
!                   ********************************
!
     &(mesh,u2d,v2d,unorm,hn,tw,uw,mu,tob,cf,tobw,fw,thetaw,
     & ava,maskpt,maskel,acladm,unladm,ksp,ksr,liqbor,
     & debug,npoin,nptfr,ielmt,icf,kent,optban,
     & hidfac,grav,dm,d90,xwc,xmve,xmvs,vce,hmin,
     & hidi,karman,zero,pi,karim_holly_yang,
     & susp,msk,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,
     & t11,t12,ac,hiding,qsc,qss,
     & slopeff,coefpn,phised,calfa,salfa,beta,zf_c,s,
     & devia,beta2,seccurrent,
     & bijk,houle,unsv2d,u3d,v3d,code,sanfra)
!
!***********************************************************************
! SISYPHE   V8P0                                   12/09/2018
!***********************************************************************
!
!brief
!
!history  E. PELTIER; C. LENORMANT; J.-M. HERVOUET
!+        20/05/1995
!+        V5P1
!+
!
!history  B. MINH DUC
!+        **/12/2001
!+        V5P2
!+
!
!history  M. GONZALES DE LINARES
!+        **/07/2002
!+        V5P3
!+
!
!history  C. VILLARET
!+        **/10/2003
!+        V5P4
!+
!
!history  F. HUVELIN
!+        14/09/2004
!+        V5P5
!+
!
!history  J.-M. HERVOUET
!+        11/03/2008
!+        V5P9
!+   MODIFICATIONS FOR PARALLEL MODE
!
!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  J-M HERVOUET (EDF-LNHE)
!+        22/02/2012
!+        V6P2
!+  Dirichlet treatment of QBOR removed
!+  It is now done in bedload_solvs_ef and vf
!+
!history  R KOPMANN (BAW)
!+        10/05/2016
!+        V7P2
!+ CALFA,SALFA dependent of grain classes
!
!history  F.CORDIER & P.TASSI (EDF-LNHE)
!+        12/09/2018
!+        V8P0
!+  PARSING of SANFRA for the formula of WILCOCK and CROWE (2003)
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| AC             |<->| CRITICAL SHIELDS PARAMETER
!| ACLADM         |-->| MEAN DIAMETER OF SEDIMENT
!| AVA            |-->| PERCENT AVAILABLE
!| BETA           |-->| COEFFICIENT FOR SLOPING BED EFFECT ( KOCH AND FLOKSTRA)
!| BETA2          |-->| COEFFICIENT FOR THE DEVIATION  (TALMON ET AL.)
!| BIJK           |-->| COEFFICIENT OF THE BIJKER FORMULA
!| CALFA          |<->| COSINUS OF THE ANGLE BETWEEN MEAN FLOW AND TRANSPORT
!| CF             |-->| QUADRATIC FRICTION COEFFICIENT
!| COEFPN         |<->| CORRECTION OF TRANSORT FOR SLOPING BED EFFECT
!| D90            |-->| D90
!| DEBUG          |-->| FLAG FOR DEBUGGING
!| DEVIA          |-->| SLOPE EFFECT FORMULA FOR DEVIATION
!| DM             |-->| SEDIMENT GRAIN DIAMETER
!| FW             |---| QUADRATIC FRICTION COEFFICIENT (WAVE)
!| GRAV           |-->| ACCELERATION OF GRAVITY
!| HIDFAC         |-->| HIDING FACTOR FORMULAS
!| HIDI           |-->| HIDING FACTOR FOR PARTICULAR SIZE CLASS (HIDFAC =0)
!| HIDING         |-->| HIDING FACTOR CORRECTION
!| HMIN           |-->| MINIMUM VALUE OF WATER DEPTH
!| HN             |-->| WATER DEPTH
!| HOULE          |-->| LOGICAL, FOR WAVE EFFECTS
!| ICF            |-->| BED-LOAD OR TOTAL LOAD TRANSPORT FORMULAS
!| IELMT          |-->| NUMBER OF ELEMENTS
!| KARMAN         |-->| VON KARMAN CONSTANT
!| KENT           |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VALUE
!| KSP            |-->| BED SKIN ROUGHNESS
!| KSR            |-->| RIPPLE BED ROUGHNESS
!| LIQBOR         |-->| TYPE OF BOUNDARY CONDITION FOR QS
!| MASKEL         |-->| MASKING OF ELEMENTS
!| MASKPT         |-->| MASKING PER POINT
!| MESH           |<->| MESH STRUCTURE
!| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS
!| MU             |<->| CORRECTION FACTOR FOR BED ROUGHNESS
!| NPOIN          |-->| NUMBER OF POINTS
!| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
!| OPTBAN         |-->| OPTION FOR TIDAL FLATS
!| PHISED         |-->| ANGLE OF REPOSE OF THE SEDIMENT
!| PI             |-->| PI
!| QSC            |<->| BED LOAD TRANSPORT
!| QSS            |<->| SUSPENDED LOAD TRANSPORT RATE
!| S              |-->| VOID STRUCTURE
!| SALFA          |<->| SINUS OF THE ANGLE BETWEEN TRANSPORT RATE AND CURRENT
!| SECCURRENT     |-->| LOGICAL, PARAMETRISATION FOR SECONDARY CURRENTS
!| SLOPEFF        |-->| LOGICAL, SLOPING BED EFFECT OR NOT
!| SUSP           |-->| LOGICAL, SUSPENSION
!| T1             |<->| WORK BIEF_OBJ STRUCTURE
!| T10            |<->| WORK BIEF_OBJ STRUCTURE
!| T11            |<->| WORK BIEF_OBJ STRUCTURE
!| T12            |<->| WORK BIEF_OBJ STRUCTURE
!| T13            |<->| WORK BIEF_OBJ STRUCTURE
!| T2             |<->| WORK BIEF_OBJ STRUCTURE
!| T3             |<->| WORK BIEF_OBJ STRUCTURE
!| T4             |<->| WORK BIEF_OBJ STRUCTURE
!| T5             |<->| WORK BIEF_OBJ STRUCTURE
!| T6             |<->| WORK BIEF_OBJ STRUCTURE
!| T7             |<->| WORK BIEF_OBJ STRUCTURE
!| T8             |<->| WORK BIEF_OBJ STRUCTURE
!| T9             |<->| WORK BIEF_OBJ STRUCTURE
!| THETAW         |-->| ANGLE BETWEEN WAVE AND CURRENT
!| TOB            |<->| BED SHEAR STRESS (TOTAL FRICTION)
!| TOBW           |-->| WAVE INDUCED SHEAR STRESS
!| TW             |-->| WAVE PERIOD
!| U2D            |<->| MEAN FLOW VELOCITY X-DIRECTION
!| UNLADM         |-->| MEAN DIAMETER OF ACTIVE STRATUM LAYER
!| UNORM          |<->| NORM OF THE MEAN FLOW VELOCITY
!| UNSV2D         |-->| INVERSE OF INTEGRALS OF TEST FUNCTIONS
!| UW             |-->| ORBITAL WAVE VELOCITY
!| V2D            |<->| MEAN FLOW VELOCITY Y-DIRECTION
!| VCE            |-->| WATER VISCOSITY
!| XMVE           |-->| FLUID DENSITY
!| XMVS           |-->| WATER DENSITY
!| XWC            |-->| SETTLING VELOCITY
!| ZERO           |-->| ZERO
!| ZF_C           |<->| BEDLOAD EVOLUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE interface_sisyphe,
     &    ex_bedload_solidischarge => bedload_solidischarge
      USE bief
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      TYPE(bief_mesh),  INTENT(INOUT) :: MESH
      TYPE(bief_obj),   INTENT(IN)    :: U2D, V2D,  HN, TW, UW
      TYPE(bief_obj),   INTENT(IN)    :: UNORM ,MU, KSR ,KSP
      TYPE(bief_obj),   INTENT(IN)    :: TOB, CF, TOBW, FW, THETAW
      TYPE(bief_obj),   INTENT(IN)    :: MASKPT, MASKEL
      TYPE(bief_obj),   INTENT(IN)    :: ACLADM, UNLADM, LIQBOR
      INTEGER,          INTENT(IN)    :: DEBUG
      INTEGER,          INTENT(IN)    :: NPOIN, NPTFR, IELMT, ICF
      INTEGER,          INTENT(IN)    :: KENT, OPTBAN,HIDFAC
      DOUBLE PRECISION, INTENT(IN)    :: GRAV, DM, D90, XWC, XMVE, XMVS
      DOUBLE PRECISION, INTENT(IN)    :: VCE, HMIN
      DOUBLE PRECISION, INTENT(IN)    :: HIDI
      DOUBLE PRECISION, INTENT(IN)    :: KARMAN, ZERO, PI
      DOUBLE PRECISION, INTENT(IN)    :: KARIM_HOLLY_YANG
      LOGICAL,          INTENT(IN)    :: SUSP, MSK,SECCURRENT,HOULE
      TYPE(bief_obj),   INTENT(INOUT) :: T1,T2,T3,T4,T5,T6
      TYPE(bief_obj),   INTENT(INOUT) :: T7,T8,T9,T10,T11,T12
      DOUBLE PRECISION, INTENT(INOUT) :: AC
      TYPE(bief_obj),   INTENT(INOUT) :: HIDING
      TYPE(bief_obj),   INTENT(INOUT) :: QSC,QSS
!
      INTEGER,          INTENT(IN)    :: SLOPEFF,DEVIA
      DOUBLE PRECISION, INTENT(IN)    :: PHISED,BETA,BETA2
      TYPE(bief_obj),   INTENT(IN)    :: ZF_C,S,UNSV2D
      TYPE(bief_obj),   INTENT(INOUT) :: CALFA,SALFA,COEFPN
!
      DOUBLE PRECISION, INTENT(IN)    :: BIJK,AVA(npoin)
!
      TYPE(bief_obj),    INTENT(IN)    :: U3D,V3D
      CHARACTER(LEN=24), INTENT(IN)    :: CODE
!
      DOUBLE PRECISION, INTENT(IN)    :: SANFRA(npoin)
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      DOUBLE PRECISION U3DNORM
!
      INTEGER          :: I
!
!======================================================================!
!                               PROGRAM                                !
!======================================================================!
!
      IF (debug > 0) WRITE(lu,*) 'BEDLOAD_EFFPNT'
!
!     SLOPE EFFECT
!
      IF(code(1:9).EQ.'TELEMAC3D') THEN
        DO i=1,npoin
          u3dnorm=sqrt(u3d%R(i)**2+v3d%R(i)**2)
          IF(u3dnorm.GE.1.d-12) THEN
            calfa%R(i)=u3d%R(i)/u3dnorm
            salfa%R(i)=v3d%R(i)/u3dnorm
          ELSE
            calfa%R(i)=1.d0
            salfa%R(i)=0.d0
          ENDIF
        ENDDO
      ELSE
        CALL os('X=Y/Z   ',x=calfa, y=u2d, z=unorm, c=0.d0,
     &                     iopt=2, infini=1.d0, zero=1.d-12)
        CALL os('X=Y/Z   ',x=salfa, y=v2d, z=unorm, c=0.d0,
     &                     iopt=2, infini=0.d0, zero=1.d-12)
      ENDIF
!
      IF(slopeff.EQ.0) CALL os('X=C     ',x=coefpn,c=1.d0)
!
      IF(slopeff.NE.0.OR.devia.NE.0) THEN
        CALL bedload_effpnt
     &     (maskel,liqbor,s,zf_c,npoin,nptfr,ielmt,
     &      kent,beta,pi,msk,mesh,t1,t2,t3,t4,
     &      coefpn,calfa,salfa,slopeff,phised,devia,beta2,
     &      tob,xmvs,xmve,dm,grav,unsv2d)
      ENDIF
!
      IF (debug > 0) WRITE(lu,*) 'END_BEDLOAD_EFFPNT'
!
!     MASKING/EXPOSURE COEFFICIENT
!
      IF (debug > 0) WRITE(lu,*) 'BEDLOAD_HIDING_FACTOR'
!
!     WITH HUNZIKER FORMULATION (6), THE HIDING FACTOR IS COMPUTED
!     WITH THE SOLID DISCHARGE (SEE BEDLOAD_HUNZ_MEYER.F)
!
      IF(icf.NE.6) THEN
        CALL bedload_hiding_factor
     &     (acladm, hidfac, npoin, hidi, dm, karim_holly_yang, hiding)
      ENDIF
      IF (debug > 0) WRITE(lu,*) 'END_BEDLOAD_HIDING_FACTOR'
!
!     QSC COMPUTED USING EMPIRICAL FORMULATION : T1 = DQSC/DH                           !
!
      IF (debug > 0) WRITE(lu,*) 'BEDLOAD_FORMULA'
!
      CALL bedload_formula
     &  (u2d,v2d, unorm,hn, cf, mu,tob, tobw, uw, tw, thetaw, fw,
     &   acladm, unladm, ksp,ksr,ava, npoin, icf, hidfac, xmvs, xmve,
     &   dm, grav, vce, hmin, xwc, d90, karman, zero,
     &   pi, susp, ac, hiding, t1, t2, t3, t4, t5, t6, t7, t8, t9,
     &   t10, t11, t12, qsc, qss, ielmt,seccurrent,
     &   slopeff, coefpn, calfa, salfa, bijk, houle, sanfra)
      IF (debug > 0) WRITE(lu,*) 'END_BEDLOAD_FORMULA'
!
!     TIDAL FLATS
!
      IF(optban.EQ.2) THEN
        IF (debug > 0) WRITE(lu,*) 'TIDAL_FLATS_TREATMENT'
        CALL os('X=XY    ', x=qsc, y=maskpt)
        IF (debug > 0) WRITE(lu,*) 'END_TIDAL_FLATS_TREATMENT'
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END