The TELEMAC-MASCARET system  trunk
bedload_formula_gaia.f
Go to the documentation of this file.
1 ! *******************************
2  SUBROUTINE bedload_formula_gaia
3 ! *******************************
4 !
5  &(u2d,v2d,unorm,hn,cf,mu,tob,tobw,uw,tw,thetaw,fw,
6  & acladm, unladm,ksp,ksr,ratio_sand,npoin,icf,hidfac,xmvs,xmve,
7  & dcla,grav,vce,hmin,xwc,karman,zero,
8  & pi,susp, ac, hiding, t1, t2, t3, t4, t5, t6, t7, t8, t9, t10,
9  & t11,tetap, qsc, qss,ielmt,seccurrent,slopeff,
10  & coefpn,calfa,salfa,bijk,houle,h_tel,
11  & hw,thetac,tobcw_mean,tobcw_max,cstaeq,sanfra)
12 !
13 !***********************************************************************
14 ! GAIA
15 !***********************************************************************
16 !
18 !
19 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
82 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
83 !
84  USE interface_gaia,ex_bedload_formula => bedload_formula_gaia
85  USE bief
86  USE declarations_gaia, ONLY : susp_sand
88  IMPLICIT NONE
89 !
90 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
91 !
92  TYPE(bief_obj), INTENT(IN) :: U2D, V2D, UNORM,HN, CF, TOB
93  TYPE(bief_obj), INTENT(IN) :: MU,TOBW, UW, TW, THETAW, FW
94  TYPE(bief_obj), INTENT(IN) :: ACLADM,UNLADM,KSR,KSP
95  INTEGER, INTENT(IN) :: NPOIN, ICF, HIDFAC,IELMT
96  DOUBLE PRECISION, INTENT(IN) :: XMVS, XMVE, DCLA, GRAV, VCE
97  DOUBLE PRECISION, INTENT(IN) :: HMIN, XWC
98  DOUBLE PRECISION, INTENT(IN) :: KARMAN, ZERO, PI
99  LOGICAL, INTENT(IN) :: SUSP,SECCURRENT,HOULE
100  DOUBLE PRECISION, INTENT(INOUT) :: AC
101  TYPE(bief_obj), INTENT(INOUT) :: HIDING
102  TYPE(bief_obj), INTENT(INOUT) :: T1, T2, T3, T4, T5, T6, T7
103  TYPE(bief_obj), INTENT(INOUT) :: T8, T9, T10,T11
104  TYPE(bief_obj), INTENT(INOUT) :: TETAP ! WORK ARRAY T12
105  TYPE(bief_obj), INTENT(INOUT) :: QSC, QSS
106  TYPE(bief_obj), INTENT(INOUT) :: COEFPN, CALFA, SALFA
107  INTEGER, INTENT(IN) :: SLOPEFF
108 !
109  DOUBLE PRECISION, INTENT (IN) :: BIJK,RATIO_SAND(npoin)
110  TYPE(bief_obj), INTENT(IN) :: H_TEL
111  TYPE(bief_obj), INTENT(IN) :: HW, THETAC
112  TYPE(bief_obj), INTENT(IN) :: TOBCW_MEAN, TOBCW_MAX
113  TYPE(bief_obj), INTENT(IN) :: CSTAEQ
114  DOUBLE PRECISION, INTENT (IN) :: SANFRA(npoin)
115 !
116 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
117 !
118  INTEGER :: I
119  DOUBLE PRECISION :: DENS,DSTAR
120  DOUBLE PRECISION, PARAMETER :: ZERO_LOCAL = 1.d-6
121  DOUBLE PRECISION :: C1
122 !
123 !======================================================================!
124 !======================================================================!
125 ! PROGRAM !
126 !======================================================================!
127 !======================================================================!
128 ! ***************************
129 ! I - ADIMENSIONAL PARAMETERS
130 ! ***************************
131 !
132 ! RELATIVE DENSITY OF SEDIMENT
133  dens = (xmvs - xmve )/ xmve
134 ! NON-DIMENSIONAL DIAMETER
135  dstar = dcla*(grav*dens/vce**2)**(1.d0/3.d0)
136 !
137 ! ************************
138 ! II - SKIN FRICTION
139 ! ************************
140 !
141  c1 = 1.d0/(dens*xmve*grav*dcla)
142  CALL os('X=CYZ ', x=tetap, y=tob,z=mu, c=c1)
143  CALL os('X=+(Y,C)', x= tetap,y=tetap, c=zero_local)
144 !
145  IF(seccurrent) CALL bedload_seccurrent_gaia(ielmt,calfa,salfa)
146 ! ******************************************
147 ! IV - COMPUTES 2 TRANSPORT TERMS
148 ! QSS : SUSPENSION
149 ! QSC : BEDLOAD
150 ! ******************************************
151 ! =====================================
152 ! IV(1) - MEYER-PETER-MULLER FORMULATION
153 ! FOR BEDLOAD ONLY
154 ! =====================================
155  IF(icf == 1) THEN
156 !
157  CALL bedload_meyer_gaia(tetap,hiding,hidfac,dens,grav,dcla,ac,
158  & t1,qsc,slopeff,coefpn,xmvs)
159  DO i=1,npoin
160  qsc%R(i)=qsc%R(i)*ratio_sand(i)
161  ENDDO
162 !
163 ! ===========================
164 ! IV(2) - EINSTEIN FORMULATION
165 ! FOR BEDLOAD ONLY
166 ! ===========================
167  ELSEIF(icf == 2) THEN
168  CALL bedload_einst_gaia(tetap,npoin,dens,grav,dcla,dstar,qsc,
169  & xmvs)
170  DO i=1,npoin
171  qsc%R(i)=qsc%R(i)*ratio_sand(i)*hiding%R(i)
172  ENDDO
173 !
174 ! ===================================
175 ! IV(30) - ENGELUND-HANSEN FORMULATION
176 ! FOR TOTAL TRANSPORT
177 ! ===================================
178  ELSEIF(icf == 30) THEN
179 ! V6P0 MU IS USED INSTEAD OF CF
180 ! BEWARE: DIFFERENCES
181 ! CALL BEDLOAD_ENGEL_GAIA(TETAP,DENS,GRAV,DCLA,QSC)
182 ! BACK TO EARLIER VERSION OF BEDLOAD_ENGEL_GAIA
183  CALL bedload_engel_gaia(tob,cf,dens,grav,dcla,xmve,t1,qsc,xmvs)
184 ! ARBITRARY DISTRIBUTION
185  DO i=1,npoin
186  qsc%R(i)=qsc%R(i)*ratio_sand(i)*hiding%R(i)
187  ENDDO
188 !
189 ! ========================================
190 ! IV(3) - ENGELUND-HANSEN FORMULATION
191 ! MODIFIED: CHOLLET ET CUNGE
192 ! FOR TOTAL TRANSPORT
193 ! ========================================
194  ELSEIF(icf == 3) THEN
195 ! KSP IS USED INSTEAD OF CFP
197  & (tetap,cf,npoin,grav,dcla,dens,t1,qsc,xmvs)
198 ! ARBITRARY DISTRIBUTION
199  DO i=1,npoin
200  qsc%R(i)=qsc%R(i)*ratio_sand(i)*hiding%R(i)
201  ENDDO
202 !
203 ! ==============================
204 ! IV(4) - BIJKER FORMULATION
205 ! FOR BEDLOAD + SUSPENSION
206 ! ==============================
207  ELSEIF (icf == 4) THEN
209  & (tobw,tob,mu,ksp,ksr,hn,npoin,dcla,dens,xmve,grav,
210  & xwc,karman,zero,t4,t7,t8,t9,qsc,qss,bijk,houle,xmvs)
211  DO i=1,npoin
212  qsc%R(i)=qsc%R(i)*ratio_sand(i)*hiding%R(i)
213  qss%R(i)=qss%R(i)*ratio_sand(i)*hiding%R(i)
214  ENDDO
215 !
216 ! ==============================
217 ! IV(5) - SOULSBY FORMULATION
218 ! FOR BEDLOAD + SUSPENSION
219 ! ==============================
220  ELSEIF (icf == 5) THEN
222  & (unorm,hn,uw,npoin,dens,grav,dcla,dstar,
223  & qsc,qss,xmvs)
224  DO i=1,npoin
225  qsc%R(i)=qsc%R(i)*ratio_sand(i)*hiding%R(i)
226  qss%R(i)=qss%R(i)*ratio_sand(i)*hiding%R(i)
227  ENDDO
228 !
229 ! ==================================================
230 ! IV(6) - HUNZIKER / MEYER-PETER & MULLER FORMULATION
231 ! FOR BEDLOAD ONLY
232 ! ==================================================
233  ELSEIF (icf == 6) THEN
235  & (tob, mu, acladm, unladm, npoin, dens, xmve, grav,
236  & dcla, ac, t1, t2, t3, hiding, qsc,xmvs)
237  DO i=1,npoin
238  qsc%R(i)=qsc%R(i)*ratio_sand(i)
239  ENDDO
240 !
241 ! ===========================
242 ! IV(7) - VAN RIJN FORMULATION
243 ! FOR BEDLOAD ONLY
244 ! ===========================
245  ELSEIF (icf == 7) THEN
246 !
248 ! & (TOB,MU,NPOIN,DCLA,DENS,GRAV,DSTAR,AC,QSC)
249  & (tetap,npoin,dcla,dens,grav,dstar,ac,qsc,xmvs)
250  DO i=1,npoin
251  qsc%R(i)=qsc%R(i)*ratio_sand(i)*hiding%R(i)
252  ENDDO
253 !
254 ! ==============================
255 ! IV(8) - BAILARD FORMULATON
256 ! FOR BEDLOAD + SUSPENSION
257 ! ==============================
258  ELSEIF (icf == 8) THEN
259 !
261  & (u2d,v2d,unorm,tob,tobw,thetaw,uw,fw,cf,npoin,
262  & pi,xmve,grav,dens,xwc,t1,t2,t3,t4,t5,t6,t7,
263  & t8,t9,t10,t11,qsc,qss,houle,xmvs)
264  DO i=1,npoin
265  qsc%R(i)=qsc%R(i)*ratio_sand(i)*hiding%R(i)
266  IF(.NOT.susp) THEN
267  qss%R(i)=qss%R(i)*ratio_sand(i)*hiding%R(i)
268  ELSE
269 ! RATIO_SAND IS TAKE IN ACCOUNT IN SUSPENSION_ERODE
270 ! AFTER COMPUTATION OF CAE
271  qss%R(i)=qss%R(i)*hiding%R(i)
272  ENDIF
273  ENDDO
274 !
275 ! =======================================
276 ! IV(9) - DIBAJNIA AND WATANABE FORMULATION
277 ! FOR TOTAL TRANSPORT
278 ! =======================================
279  ELSEIF(icf == 9) THEN
280 !
282  & (u2d,v2d,unorm, cf, tob, tobw, uw, tw, fw, thetaw,
283  & npoin, xmve, dens, grav, dcla, xwc, pi, t1, t2, t3, t4,
284  & t5, t6, t7, t8, t9, t10, t11, qsc,xmvs)
285 ! ARBITRARY DISTRIBUTION
286  DO i=1,npoin
287  qsc%R(i)=qsc%R(i)*ratio_sand(i)*hiding%R(i)
288  ENDDO
289 !
290 ! =======================================
291 ! IV(10) - WILCOCK AND CROWE 2003 FORMULATION
292 ! NON-UNIFORM TRANSPORT
293 ! =======================================
294  ELSEIF(icf == 10) THEN
295 !
297  & (tob, mu, acladm, dcla, ratio_sand, grav, xmve, xmvs, sanfra,
298  & qsc, ac, t1, slopeff, coefpn)
299 !
300 ! ============================================
301 ! IV(0) - USER-DEFINED FORMULATION
302 ! ============================================
303  ELSEIF (icf == 0) THEN
304  CALL user_bedload_qb
305  & (hn, u2d, v2d, thetac, houle, hw, tw, thetaw,
306  & tob,tobw,tobcw_mean,tobcw_max, dcla, dens, grav, dstar,
307  & ac,xmve, xmvs, tetap, mu, npoin, qsc, qss, cstaeq)
308 !
309  DO i=1,npoin
310  qsc%R(i)=qsc%R(i)*ratio_sand(i)*hiding%R(i)
311  qss%R(i)=qss%R(i)*ratio_sand(i)*hiding%R(i)
312  ENDDO
313 ! =================
314 ! IV(ELSE) - ERROR
315 ! =================
316  ELSE
317  WRITE(lu,201) icf
318 201 FORMAT(1x,'TRANSP : TRANSPORT FORMULA UNKNOWN:',1i6)
319  CALL plante(1)
320  stop
321  ENDIF
322 !
323 !-----------------------------------------------------------------------
324 !
325 ! WHEN SUSPENSION IS NOT ASKED SPECIFICALLY, SOME BEDLOAD TRANSPORT
326 ! FORMULAS GIVE A VALUE
327 !
328  IF(.NOT.susp_sand) THEN
329  IF(icf.EQ.4.OR.icf.EQ.5.OR.icf.EQ.8.OR.icf.EQ.0) THEN
330  IF(.NOT.susp)THEN
331 ! BEDLOAD IS TOTAL LOAD IN THIS CASE
332  DO i = 1,npoin
333  qsc%R(i) = qsc%R(i) + qss%R(i)
334  ENDDO
335  ELSE
336  WRITE(lu,*)'WARNING, WITH COHESIVE SEDIMENT IN SUSPENSION'
337  WRITE(lu,*)'AND ONLY BEDLOAD FOR SAND:'
338  WRITE(lu,*)'IT IS ASSUMED THAT:'
339  WRITE(lu,*)'1- BEDLOAD OF SAND IS NOT TOTAL BEDLOAD (QSS = 0).'
340  WRITE(lu,*)'2- EROSION FLUX OF SAND USED TO COMPUTE EROSION FLUX'
341  WRITE(lu,*)' OF MIXED SEDIMENT IN SUSPENSION IS EQUAL TO 0.'
342  DO i = 1,npoin
343  qss%R(i) = 0.d0
344  ENDDO
345  ENDIF
346  ELSE
347 ! NOTE JMH: IS THIS REALLY USEFUL ???
348  DO i = 1,npoin
349  qss%R(i) = 0.d0
350  ENDDO
351  ENDIF
352  ENDIF
353 ! NO BEDLOAD IF H_TEL < HMIN (NOT USE HN BECAUSE HN = HMIN IN THIS CASE)
354  DO i = 1,npoin
355  IF(h_tel%R(i).LT.hmin) THEN
356  qsc%R(i) = 0.d0
357  qss%R(i) = 0.d0
358  ENDIF
359  ENDDO
360 !
361 !=======================================================================
362 !=======================================================================
363 !
364  RETURN
365  END
subroutine bedload_engel_gaia(TOB, CF, DENS, GRAV, DCLA, XMVE, TETA, QSC, XMVS)
subroutine bedload_meyer_gaia(TETAP, HIDING, HIDFAC, DENS, GRAV, DCLA, AC, ACP, QSC, SLOPEFF, COEFPN, XMVS)
subroutine bedload_vanrijn_gaia(TETAP, NPOIN, DCLA, DENS, GRAV, DSTAR, AC, QSC, XMVS)
subroutine bedload_formula_gaia(U2D, V2D, UNORM, HN, CF, MU, TOB, TOBW, UW, TW, THETAW, FW, ACLADM, UNLADM, KSP, KSR, RATIO_SAND, NPOIN, ICF, HIDFAC, XMVS, XMVE, DCLA, GRAV, VCE, HMIN, XWC, KARMAN, ZERO, PI, SUSP, AC, HIDING, T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T11, TETAP, QSC, QSS, IELMT, SECCURRENT, SLOPEFF, COEFPN, CALFA, SALFA, BIJK, HOULE, H_TEL, HW, THETAC, TOBCW_MEAN, TOBCW_MAX, CSTAEQ, SANFRA)
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_dibwat_gaia(U2D, V2D, UNORM, CF, TOB, TOBW, UW, TW, FW, THETAW, NPOIN, XMVE, DENS, GRAV, DCLA, XWC, PI, ALPHAW, T2, T3, UCW, UCN, UW1, UW2, TW1, TW2, THETAC, FCW, QSC, XMVS)
subroutine bedload_hunz_meyer_gaia(TOB, MU, ACLADM, UNLADM, NPOIN, DENS, XMVE, GRAV, DCLA, AC, TETAP, AHUNZI, ACP, HIDING, QSC, XMVS)
subroutine bedload_wilcock_crowe_gaia(TOB, MU, ACLADM, DCLA, RATIO_SAND, GRAV, XMVE, XMVS, SANFRA, QSC, AC, ACP, SLOPEFF, COEFPN)
subroutine bedload_einst_gaia(TETAP, NPOIN, DENS, GRAV, DCLA, DSTAR, QSC, XMVS)
subroutine bedload_engel_cc_gaia(TETAP, CF, NPOIN, GRAV, DCLA, DENS, TETA, QSC, XMVS)
subroutine bedload_bijker_gaia(TOBW, TOB, MU, KSP, KSR, HN, NPOIN, DCLA, DENS, XMVE, GRAV, XWC, KARMAN, ZERO, T4, T7, T8, T9, QSC, QSS, BIJK, HOULE, XMVS)
logical, target susp_sand
Suspension for all sands (mud is assumed to be suspended)
subroutine user_bedload_qb(HN, U2D, V2D, THETAC, HOULE, HW, TW, THETAW, TOB, TOBW, TOBCW_MEAN, TOBCW_MAX, DCLA, DENS, GRAV, DSTAR, AC, XMVE, XMVS, TETAP, MU, NPOIN, QSC, QSS, CSTAEQ)
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
subroutine bedload_seccurrent_gaia(IELMU, CALFA, SALFA)
subroutine bedload_soulsby_gaia(UNORM, HN, UW, NPOIN, DENS, GRAV, DCLA, DSTAR, QSC, QSS, XMVS)
Definition: bief.f:3