The TELEMAC-MASCARET system  trunk
bedload_bailard_gaia.f
Go to the documentation of this file.
1 ! *******************************
2  SUBROUTINE bedload_bailard_gaia
3 ! *******************************
4  &(u2d,v2d,unorm,tob,tobw,thetaw,uw,fw,cf,npoin,pi,
5  & xmve,grav,dens,xwc,alphaw,qscx,qscy,qssx,qssy,
6  & uc3x,uc3y,us4x,us4y,thetac,fcw,qsc,qss,houle,xmvs)
7 ! *******************************
8 !
9 !***********************************************************************
10 ! GAIA
11 !***********************************************************************
12 !
14 !
15 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
46 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
47 !
48  USE interface_gaia,ex_bedload_bailard => bedload_bailard_gaia
49  USE bief
51  IMPLICIT NONE
52 !
53 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
54 !
55  TYPE(bief_obj), INTENT(IN) :: U2D,V2D,UNORM, TOB
56  TYPE(bief_obj), INTENT(IN) :: TOBW, THETAW, UW, FW, CF
57  INTEGER, INTENT(IN) :: NPOIN
58  LOGICAL, INTENT(IN) :: HOULE
59  DOUBLE PRECISION, INTENT(IN) :: PI, XMVE, GRAV, DENS, XWC,XMVS
60  TYPE(bief_obj), INTENT(INOUT) :: ALPHAW
61  TYPE(bief_obj), INTENT(INOUT) :: QSCX, QSCY
62  TYPE(bief_obj), INTENT(INOUT) :: QSSX, QSSY
63  TYPE(bief_obj), INTENT(INOUT) :: UC3X, UC3Y
64  TYPE(bief_obj), INTENT(INOUT) :: US4X, US4Y
65  TYPE(bief_obj), INTENT(INOUT) :: THETAC, FCW
66  TYPE(bief_obj), INTENT(INOUT) :: QSC, QSS
67 !
68 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
69 !
70 !
71 ! LOCAL VARIABLES
72 !
73  INTEGER :: I
74  DOUBLE PRECISION :: C3, C4, PHI
75  DOUBLE PRECISION, PARAMETER :: EPSC = 0.21d0 ! BEDLOAD
76  DOUBLE PRECISION, PARAMETER :: EPSS = 0.025d0 ! SUSPENSION
77  DOUBLE PRECISION :: U3X, U3Y, NUM
78 !
79 !======================================================================!
80 !======================================================================!
81 ! PROGRAM !
82 !======================================================================!
83 !======================================================================!
84 !
85 ! CASE WITH WAVES
86 !
87  IF(houle) THEN
88 !
89 ! ANGLE OF VELOCITY WITH OX (IN RADIANS)
90 !
91  CALL bedload_direction_gaia(u2d,v2d,npoin,pi,thetac)
92 !
93 ! ANGLE OF WAVES WITH OX (IN RADIANS)
94 !
95  CALL os('X=CY ', x=alphaw, y=thetaw, c=-pi/180.d0)
96  CALL os('X=X+C ', x=alphaw, c=0.5d0*pi)
97  CALL os('X=Y-Z ', x=alphaw, y=alphaw, z=thetac)
98 !
99 ! PARAMETERS ,
100 !
101 !
102 ! US4X AND US4Y ARE WORK ARRAYS, THEIR STRUCTURE IS GIVEN HERE
103 ! THE STRUCTURE OF THETAC (CATHERINE DON'T REMOVE THIS PLEASE)
104  CALL cpstvc(thetac,us4x)
105  CALL cpstvc(thetac,us4y)
106 !
107  DO i = 1, npoin
108  ! ********************* !
109  ! I - CURRENT REFERENCE SYSTEM !
110  ! ********************* !
111  u3x = unorm%R(i)**3
112  & + unorm%R(i)*uw%R(i)**2 * (1 + cos(2.d0*alphaw%R(i))/ 2.d0)
113  u3y = unorm%R(i)*uw%R(i)**2 * sin(2.d0*alphaw%R(i)) / 2.d0
114  ! ********************************************** !
115  ! II - 3RD ORDER MOMENTUM (LINEAR WAVE THEORY) !
116  ! ********************************************** !
117  uc3x%R(i) = u3x * cos(thetac%R(i)) - u3y * sin(thetac%R(i))
118  uc3y%R(i) = u3x * sin(thetac%R(i)) + u3y * cos(thetac%R(i))
119  ! ************************************************************ !
120  ! III - 4TH ORDER MOMENTUM (COLINEAR WAVES AND CURRENTS) !
121  ! ************************************************************ !
122  num = ( 8.d0*unorm%R(i)**4 + 3.d0*uw%R(i)**4
123  & + 24.d0*(unorm%R(i)**2)*(uw%R(i)**2) )*0.125d0
124  us4x%R(i) = num * cos(thetac%R(i))
125  us4y%R(i) = num * sin(thetac%R(i))
126  ENDDO
127  ! *********************************************** !
128  ! IV - FRICTION COEFFICIENT WAVE + CURRENT !
129  ! *********************************************** !
131  & (unorm,tobw,tob,alphaw,fw,cf,uw,npoin,xmve,fcw)
132  ! ******************************** !
133  ! V - TRANSPORT RATES !
134  ! ******************************** !
135  phi = pi / 6.d0 ! FRICTION ANGLE
136  c3 = epsc / (grav*dens*tan(phi))
137  c4 = epss / (grav*dens*xwc)
138  CALL os('X=CYZ ', x=qscx, y=fcw, z=uc3x, c=c3)
139  CALL os('X=CYZ ', x=qscy, y=fcw, z=uc3y, c=c3)
140  CALL os('X=CYZ ', x=qssx, y=fcw, z=us4x, c=c4)
141  CALL os('X=CYZ ', x=qssy, y=fcw, z=us4y, c=c4)
142 !
143 ! CASE WITHOUT WAVES
144 !
145  ELSE
146 !
147  WRITE(lu,*) 'BAILARD WITHOUT WAVES NOT PROGRAMMED'
148  CALL plante(1)
149  stop
150 !
151  ENDIF
152 !
153 ! NORMS
154 !
155  CALL os('X=N(Y,Z)', x=qsc, y=qscx, z=qscy)
156  CALL os('X=N(Y,Z)', x=qss, y=qssx, z=qssy)
157 !======================================================================!
158 ! SOLID DISCHARGE IS TRANSFORMED IN [kg/(m*s)]
159 !
160  CALL os('X=CX ', x=qsc, c=xmvs)
161  CALL os('X=CX ', x=qss, c=xmvs)
162 !======================================================================!
163  RETURN
164  END
subroutine bedload_interact_gaia(UCMOY, TOBW, TOB, ALPHAW, FW, CF, UW, NPOIN, XMVE, FCW)
subroutine bedload_bailard_gaia(U2D, V2D, UNORM, TOB, TOBW, THETAW, UW, FW, CF, NPOIN, PI, XMVE, GRAV, DENS, XWC, ALPHAW, QSCX, QSCY, QSSX, QSSY, UC3X, UC3Y, US4X, US4Y, THETAC, FCW, QSC, QSS, HOULE, XMVS)
subroutine bedload_direction_gaia(U2D, V2D, NPOIN, PI, THETAC)
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