The TELEMAC-MASCARET system  trunk
bedload_wilcock_crowe_gaia.f
Go to the documentation of this file.
1 ! *************************************
3 ! *************************************
4 !
5  &(tob, mu, acladm, dcla, ratio_sand, grav, xmve, xmvs, sanfra, qsc,
6  & ac, acp, slopeff,coefpn)
7 !
8 !***********************************************************************
9 ! GAIA
10 !***********************************************************************
11 !
12 !brief WILCOCK AND CROWE NON-UNIFORM TRANSPORT FORMULATION.
13 !
14 !history F.CORDIER & P. TASSI (EDF-LNHE)
15 !+ 16/09/2018
16 !+ V8P0 (in GAIA)
17 !+ Implementation of the Wilcock and Crowe formula
18 !
19 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
34 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
35 !
36  USE bief
37  USE interface_gaia,
38  & ex_bedload_wilcock_crowe_gaia => bedload_wilcock_crowe_gaia
40  IMPLICIT NONE
41 !
42 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
43 !
44  INTEGER, INTENT(IN) :: SLOPEFF
45  TYPE(bief_obj), INTENT(INOUT) :: QSC, COEFPN
46  DOUBLE PRECISION, INTENT(IN) :: XMVE, XMVS, GRAV, DCLA, AC,
47  & ratio_sand(qsc%DIM1)
48  DOUBLE PRECISION, INTENT(IN) :: SANFRA(qsc%dim1)
49  TYPE(bief_obj), INTENT(INOUT) :: ACP ! WORK ARRAY T1
50  TYPE(bief_obj), INTENT(IN) :: ACLADM
51  TYPE(bief_obj), INTENT(IN) :: TOB, MU
52 !
53 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
54 !
55  INTEGER I
56  DOUBLE PRECISION TORM, TORI, TORATIO, WI, COEFB, WCC
57 !
58 !======================================================================!
59 ! PROGRAM !
60 !=======================================================================
61 !
62  CALL cpstvc(qsc,acp)
63  CALL os('X=C ', x=acp, c=ac)
64 !
65 ! SLOPE EFFECT: SOULBY FORMULATION
66 !
67  IF(slopeff.EQ.2) THEN
68  CALL os('X=XY ', x=acp, y=coefpn)
69  ENDIF
70 !
71 ! COEFFICIENT TO CALIBRATE THE FORMULA (by default = 1.0)
72  wcc = 1.0d0
73 !
74  DO i=1,qsc%DIM1
75  torm = (0.021d0 + 0.015d0*exp(-20.d0*sanfra(i)))*
76  & (xmvs/xmve-1.d0)*xmve*grav*acladm%R(i)
77  coefb = 0.67d0/(1.0d0+exp(1.5d0-dcla/acladm%R(i)))
78  tori = torm*((dcla/acladm%R(i))**coefb)
79  toratio = tob%R(i)*mu%R(i)/tori
80  IF (toratio.LT.1.35d0) THEN
81  wi = 2.d-3*(toratio**7.5d0)
82  ELSE
83  wi = 14.d0*((1.d0-0.894d0/sqrt(toratio))**4.5d0)
84  ENDIF
85 !
86  qsc%R(i)=wcc*wi*ratio_sand(i)*((tob%R(i)*mu%R(i)
87  & /xmve)**1.5d0)/((xmvs/xmve-1.d0)*grav)
88 ! IF VERY LOW TRANSPORT WE IMPOSE QB = 0 (TO AVOID NUMERICAL
89 ! ARTIFACTS)
90  IF (qsc%R(i).LT.1.d-13) THEN
91  qsc%R(i)=0.0d0
92  ENDIF
93  ENDDO
94 !
95 !======================================================================!
96 ! SOLID DISCHARGE IS TRANSFORMED IN [kg/(m*s)]
97 !
98  CALL os('X=CX ', x=qsc, c=xmvs)
99 !=======================================================================
100 !
101  RETURN
102  END
103 !
subroutine bedload_wilcock_crowe_gaia(TOB, MU, ACLADM, DCLA, RATIO_SAND, GRAV, XMVE, XMVS, SANFRA, QSC, AC, ACP, SLOPEFF, COEFPN)
subroutine cpstvc(X, Y)
Definition: cpstvc.f:7
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
Definition: bief.f:3