You need to sign in or sign up before continuing.
Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
! *****************************
SUBROUTINE BEDLOAD_MEYER_GAIA
! *****************************
!
&(TETAP,HIDING,HIDFAC,DENS,GRAV,DCLA,AC,ACP,QSC,SLOPEFF,COEFPN,
& XMVS)
!
!***********************************************************************
! GAIA
!***********************************************************************
!
! Ajout d'un critère sur le D50 pour le charriage du sable.
! Utile si on a désactivé le charriage???
! Critère = 250µm
!
!***********************************************************************
!
!>@brief Meyer-Peter bedload transport formulation.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!>@param[in] AC Critical shields parameter
!>@param[in,out] ACP Modified shields parameter
!>@param[in,out] COEFPN Correction of transport for sloping bed effect
!>@param[in] DENS Relative density of sediment
!>@param[in] DCLA Sediment grain diameter
!>@param[in] GRAV Acceleration of gravity
!>@param[in] HIDFAC Hiding factor formulas
!>@param[in] HIDING Hiding factor correction
!>@param[in,out] QSC Bed load transport rate
!>@param[in] SLOPEFF Formula for slope effect
!>@param[in] TETAP Adimensional skin friction
!>@param[in] XMVS Sediment density
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
USE BIEF
USE INTERFACE_GAIA, EX_BEDLOAD_MEYER => BEDLOAD_MEYER_GAIA
USE DECLARATIONS_GAIA, ONLY : MPM_ARAY
USE DECLARATIONS_SPECIAL
IMPLICIT NONE
!
!!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
TYPE(BIEF_OBJ), INTENT(IN) :: TETAP, HIDING
INTEGER, INTENT(IN) :: HIDFAC, SLOPEFF
DOUBLE PRECISION, INTENT(IN) :: DENS, GRAV, DCLA, AC, XMVS
TYPE(BIEF_OBJ), INTENT(INOUT) :: ACP ! WORK ARRAY T1
TYPE(BIEF_OBJ), INTENT(INOUT) :: QSC, COEFPN
!
!!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
INTEGER I
DOUBLE PRECISION :: C2
!
!======================================================================!
! PROGRAM !
!=======================================================================
!
CALL CPSTVC(QSC,ACP)
CALL OS('X=C ', X=ACP, C=AC)
!
! SLOPE EFFECT: SOULBY FORMULATION
!
IF(SLOPEFF.EQ.2) THEN
CALL OS('X=XY ', X=ACP, Y=COEFPN )
ENDIF
!
! BEDLOAD TRANSPORT CORRECTED FOR EXTENDED GRAIN SIZE
! WITH VARIABLE MPM_COEFFICIENT
!
C2 = SQRT(GRAV*DENS*DCLA**3)
! print *, C2,DCLA
!
IF(HIDFAC.EQ.1.OR.HIDFAC.EQ.2) THEN
! CALL OS('X=XY ', X=ACP, Y=HIDING)
! CALL OS('X=Y-Z ', X=QSC, Y=TETAP, Z=ACP)
! CALL OS('X=+(Y,C)', X=QSC, Y=QSC , C=0.D0)
! CALL OS('X=Y**C ', X=QSC, Y=QSC , C=1.5D0)
! CALL OS('X=CX ', X=QSC, C=C2)
! CALL OS('X=XY ', X=QSC, Y=MPM_ARAY)
DO I=1,QSC%DIM1
if (DCLA.gt.0.00025) then
QSC%R(I)=C2*MPM_ARAY%R(I)
& *SQRT(MAX(TETAP%R(I)-ACP%R(I)*HIDING%R(I),0.D0))**3
else
QSC%R(I)=0.
! print *, 'coucou 2nd sand'
endif
ENDDO
ELSE
! CALL OS('X=Y-Z ', X=QSC, Y=TETAP, Z=ACP)
! CALL OS('X=+(Y,C)', X=QSC, Y=QSC, C=0.D0)
! CALL OS('X=Y**C ', X=QSC, Y=QSC, C=1.5D0)
! CALL OS('X=CX ', X=QSC, C=C2)
! CALL OS('X=XY ', X=QSC, Y=HIDING)
! CALL OS('X=XY ', X=QSC, Y=MPM_ARAY)
DO I=1,QSC%DIM1
if (DCLA.gt.0.00025) then
QSC%R(I)=C2*MPM_ARAY%R(I)*HIDING%R(I)*SQRT(
& MAX(TETAP%R(I)-ACP%R(I),0.D0))**3
else
QSC%R(I)=0.
! print *, 'coucou 2nd sand'
endif
ENDDO
ENDIF
!
! SOLID DISCHARGE IS TRANSFORMED IN [kg/(m*s)]
!
CALL OS('X=CX ', X=QSC, C=XMVS)
!=======================================================================
!
RETURN
END