The TELEMAC-MASCARET system  trunk
bedload_meyer_gaia.f
Go to the documentation of this file.
1 ! *****************************
2  SUBROUTINE bedload_meyer_gaia
3 ! *****************************
4 !
5  &(tetap,hiding,hidfac,dens,grav,dcla,ac,acp,qsc,slopeff,coefpn,
6  & xmvs)
7 !
8 !***********************************************************************
9 ! GAIA
10 !***********************************************************************
11 !
13 !
14 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
27 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
28 !
29  USE bief
30  USE interface_gaia, ex_bedload_meyer => bedload_meyer_gaia
31  USE declarations_gaia, ONLY : mpm_aray
33  IMPLICIT NONE
34 !
35 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
36 
37  TYPE(bief_obj), INTENT(IN) :: TETAP, HIDING
38  INTEGER, INTENT(IN) :: HIDFAC, SLOPEFF
39  DOUBLE PRECISION, INTENT(IN) :: DENS, GRAV, DCLA, AC, XMVS
40  TYPE(bief_obj), INTENT(INOUT) :: ACP ! WORK ARRAY T1
41  TYPE(bief_obj), INTENT(INOUT) :: QSC, COEFPN
42 !
43 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
44 !
45  INTEGER I
46  DOUBLE PRECISION :: C2
47 !
48 !======================================================================!
49 ! PROGRAM !
50 !=======================================================================
51 !
52  CALL cpstvc(qsc,acp)
53  CALL os('X=C ', x=acp, c=ac)
54 !
55 ! SLOPE EFFECT: SOULBY FORMULATION
56 !
57  IF(slopeff.EQ.2) THEN
58  CALL os('X=XY ', x=acp, y=coefpn )
59  ENDIF
60 !
61 ! BEDLOAD TRANSPORT CORRECTED FOR EXTENDED GRAIN SIZE
62 ! WITH VARIABLE MPM_COEFFICIENT
63 !
64  c2 = sqrt(grav*dens*dcla**3)
65 !
66  IF(hidfac.EQ.1.OR.hidfac.EQ.2) THEN
67 ! CALL OS('X=XY ', X=ACP, Y=HIDING)
68 ! CALL OS('X=Y-Z ', X=QSC, Y=TETAP, Z=ACP)
69 ! CALL OS('X=+(Y,C)', X=QSC, Y=QSC , C=0.D0)
70 ! CALL OS('X=Y**C ', X=QSC, Y=QSC , C=1.5D0)
71 ! CALL OS('X=CX ', X=QSC, C=C2)
72 ! CALL OS('X=XY ', X=QSC, Y=MPM_ARAY)
73  DO i=1,qsc%DIM1
74  qsc%R(i)=c2*mpm_aray%R(i)
75  & *sqrt(max(tetap%R(i)-acp%R(i)*hiding%R(i),0.d0))**3
76  ENDDO
77  ELSE
78 ! CALL OS('X=Y-Z ', X=QSC, Y=TETAP, Z=ACP)
79 ! CALL OS('X=+(Y,C)', X=QSC, Y=QSC, C=0.D0)
80 ! CALL OS('X=Y**C ', X=QSC, Y=QSC, C=1.5D0)
81 ! CALL OS('X=CX ', X=QSC, C=C2)
82 ! CALL OS('X=XY ', X=QSC, Y=HIDING)
83 ! CALL OS('X=XY ', X=QSC, Y=MPM_ARAY)
84  DO i=1,qsc%DIM1
85  qsc%R(i)=c2*mpm_aray%R(i)*hiding%R(i)*sqrt(
86  & max(tetap%R(i)-acp%R(i),0.d0))**3
87  ENDDO
88  ENDIF
89 !
90 ! SOLID DISCHARGE IS TRANSFORMED IN [kg/(m*s)]
91 !
92  CALL os('X=CX ', x=qsc, c=xmvs)
93 !=======================================================================
94 !
95  RETURN
96  END
subroutine bedload_meyer_gaia(TETAP, HIDING, HIDFAC, DENS, GRAV, DCLA, AC, ACP, QSC, SLOPEFF, COEFPN, XMVS)
subroutine cpstvc(X, Y)
Definition: cpstvc.f:7
type(bief_obj), target mpm_aray
Meyer Peter Mueller factor.
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
Definition: bief.f:3