The TELEMAC-MASCARET system  trunk
suspension_main.f
Go to the documentation of this file.
1 ! **************************
2  SUBROUTINE suspension_main
3 ! **************************
4 !
5  &(slvtra,hn,hn_tel,mu,tob,fdm,fd90,ksp,ksr,ks,volu2d,v2dpar,unsv2d,
6  & afbor,bfbor,zf,licbor,ifamas,maskel,maskpt,u2d,v2d,nsicla,npoin,
7  & nptfr,ielmt,optdif,resol,lt,nit,optban,optadv,opdtra,
8  & kent,ksort,klog,kneu,kdir,kddl,debug,
9  & dts,csf_sable,zero,grav,xkx,xky,karman,
10  & xmve,xmvs,vce,hmin,xwc,vitcd,partheniades,bilma,msk,
11  & charr,imp_inflow_c,mesh,zf_s,cs,cst,ctild,cbor,disp,
12  & it1,it2,it3,it4,tb,t1,t2,t3,t4,t8,t9,t10,t11,t12,t14,
13  & te1,clt,te2,te3,s,am1_s,am2_s,mbor,elay,limdif,
14  & masktr, teta_susp, ac, mased0, masini, masten,
15  & mastou, es,es_sable, es_vase,avail, entets, pass, zfcl_s,
16  & hprop, fludpt, fludp, fluer, disp_c, kx, ky,
17  & kz, uconv, vconv,qsxs, qsys, qsclxs, qsclys, qscl_s,
18  & qs_s,qs_c,cstaeq,csratio,icq,mastcp,masfin,masdept,masdep,massou,
19  & corr_conv,zref,sedco,visc_tel,code,
20  & dift,dm1,uconv_tel,vconv_tel,zconv,solsys,flbor_tel,flbor_sis,
21  & flbortra,numliq,nfrliq,mixte,nomblay,conc,
22  & toce_vase,toce_sable,fluer_vase,toce_mixte,ms_sable,ms_vase,
23  & dirflu,maxadv)
24 !
25 !***********************************************************************
26 ! SISYPHE V6P2 18/06/2012
27 !***********************************************************************
28 !
29 !brief MAIN SUBROUTINE FOR THE SUSPENDED-LOAD TRANSPORT.
30 !
31 !history F. HUVELIN
32 !+ 22/12/2004
33 !+
34 !+
35 !history JMH
36 !+ 25/06/2008
37 !+ V5P9
38 !+ CALL TO DIFFIN MOVED IN SUSPENSION_COMPUTATION
39 !
40 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
41 !+ 13/07/2010
42 !+ V6P0
43 !+ Translation of French comments within the FORTRAN sources into
44 !+ English comments
45 !
46 !history N.DURAND (HRW), S.E.BOURBAN (HRW)
47 !+ 21/08/2010
48 !+ V6P0
49 !+ Creation of DOXYGEN tags for automated documentation and
50 !+ cross-referencing of the FORTRAN sources
51 !+
52 !history C. VILLARET
53 !+ 20/03/2011
54 !+ V6P1
55 !+ BUG CORRECTION : SEND FDM(I) instead of ACLADM
56 !+ suppression of NSOUS, ISOUS
57 !+ adding VCE, TOCE_SABLE
58 !+
59 !history J.-M. HERVOUET
60 !+ 19/04/2011
61 !+ V6P1
62 !+ COMPUTATION OF INITIAL MASS CHANGED
63 !+
64 !history C.VILLARET (EDF-LNHE), P.TASSI (EDF-LNHE)
65 !+ 19/07/2011
66 !+ V6P1
67 !+ Name of variables
68 !
69 !history MAK (HRW)
70 !+ 31/05/2012
71 !+ V6P2
72 !+ Include CSRATIO
73 !
74 !history PAT (LNHE)
75 !+ 18/06/2012
76 !+ V6P2
77 !+ updated version with HRW's development for Soulsby-van Rijn's concentration
78 !+ V6P2
79 !
80 !history C. VILLARET
81 !+ 21/08/2012
82 !+ V6P2
83 !+ Added call variable to suspension_computation
84 !
85 !history C. VILLARET
86 !+ 28/08/2012
87 !+ V6P2
88 !+ Added ES_SABLE and ES_VASE
89 !+ Replaced CONC_VASE by CONC
90 !
91 !history J-M HERVOUET (EDF LAB, LNHE)
92 !+ 28/04/2014
93 !+ V7P0
94 !+ OPTSUP replaced by OPTADV in the call to suspension_computation.
95 !+ (see keyword SCHME OPTION FOR ADVECTION)
96 !
97 !history J-M HERVOUET (EDF LAB, LNHE)
98 !+ 28/03/2017
99 !+ V7P3
100 !+ HPROP is not equal to HN in coupling, but to HN_TEL, in Sisyphe
101 !+ what is called HN is in fact H in Telemac-2D or 3D.
102 !
103 !history J,RIEHME (ADJOINTWARE)
104 !+ November 2016
105 !+ V7P2
106 !+ Replaced EXTERNAL statements to parallel functions / subroutines
107 !+ by the INTERFACE_PARALLEL
108 !
109 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
110 !| AC |<->| CRITICAL SHIELDS PARAMETER
111 !| ACLADM |-->| MEAN DIAMETER OF SEDIMENT
112 !| AFBOR |-->| BOUNDARY CONDITION ON F: NU*DF/DN=AFBOR*F+BFBOR
113 !| AM1_S |<->| MATRIX OBJECT
114 !| AM2_S |<->| MATRIX OBJECT
115 !| AVAIL |<->| VOLUME PERCENT OF EACH CLASS AND PER LAYER
116 !| BFBOR |-->| BOUNDARY CONDITION ON F: NU*DF/DN=AFBOR*F+BFBOR
117 !| BILMA |-->| MASS BALANCE
118 !| CBOR |<->| IMPOSED SUSPENDED SAND CONCENTRATION AT THE BOUNDARY
119 !| CF |-->| QUADRATIC FRICTION COEFFICIENT
120 !| CHARR |-->| LOGICAL, BEDLOAD OR NOT
121 !| CLT |<->| BOUNDARY CONDITIONS FOR TRACER (MODIFIED LITBOR)
122 !| CODE |-->| HYDRODYNAMIC CODE IN CASE OF COUPLING
123 !| CONC_VASE |<->| MUD CONCENTRATION FOR EACH LAYER (KG/M3)
124 !| CORR_CONV |-->| LOGICAL, CORRECTION ON CONVECTION VELOCITY OR NOT
125 !| CS |<->| CONCENTRATION AT TIME N
126 !| CSF_SABLE |-->| VOLUME CONCENTRATION OF SAND (1-POROSITY)
127 !| CST |<->| CONCENTRATION AT TIME T(N+1)
128 !| CSTAEQ |<->| EQUILIBRIUM CONCENTRATION
129 !| CTILD |<->| CONCENTRATION AFTER ADVECTION
130 !| DEBUG |-->| FLAG FOR DEBUGGING
131 !| DIFT |-->| DIFFUSION OF SUSPENDED SEDIMENT CONCENTRATION
132 !| DISP |-->| VISCOSITY COEFFICIENTS ALONG X,Y AND Z .
133 !| | | IF P0 : PER ELEMENT
134 !| | | IF P1 : PERR POINT
135 !| DISP_S |<->| WORK ARRAY FOR SAVING DISPC
136 !| DM1 |-->| THE PIECE-WISE CONSTANT PART OF ADVECTION FIELD
137 !| | | IS DM1*GRAD(ZCONV)
138 !| DTS |-->| TIME STEP FOR SUSPENSION
139 !| ELAY |<->| THICKNESS OF TOP ACTIVE LAYER (SANG GRADING ALGORITHM)
140 !| |<->| THICKNESS OF THE WHOLE COHESIVE SEDIMENT BED (CONSOLIDATION)
141 !| ENTET |<->| LOGICAL, IF YES INFORMATION IS GIVEN ON MASS CONSERVATION
142 !| ENTETS |-->| LOGICAL, IF YES INFORMATION IS GIVEN ON MASS CONSERVATION FOR SUSPENSION
143 !| ES |<->| THICKNESS OF EACH LAYER (M)
144 !| ES_VASE |<->| THICKNESS OF THE MUD LAYER (M)
145 !| ES_SABLE |<->| THICKNESS OF THE SAND LAYER (M)
146 !| FDM |-->| GRAIN SIZE PER SEDIMENT CLASS
147 !| FLBORTRA |<->| FLUXES AT BOUNDARIES TRACER
148 !| FLBOR_SIS |<->| FLUXES AT BOUNDARIES SISYPHE
149 !| FLBOR_TEL |-->| FLUXES AT BOUNDARIES TELEMAC
150 !| FLUDP |<->| DEPOSITION FLUX (M/S)
151 !| FLUDPT |<->| DEPOSITION FLUX (IMPLICIT)
152 !| FLUER |<->| EROSION FLUX (M/S)
153 !| FLUER_VASE |<->| EROSION FLUX (M/S)FOR MIXED SEDIMENTS
154 !| GRAV |-->| ACCELERATION OF GRAVITY
155 !| HMIN |-->| MINIMUM VALUE OF WATER DEPTH (M)
156 !| HN |-->| WATER DEPTH (M)
157 !| HN_TEL |-->| WATER DEPTH SENT BY TELEMAC OR CALLING CODE
158 !| HPROP |<->| PROPAGATION DEPTH (DONE IN CVDFTR)
159 !| ICQ |-->| FLAG FOR REFERENCE CONCENTRATION FORMULA
160 !| IELMT |-->| NUMBER OF ELEMENTS
161 !| IFAMAS |-->| A MODIFIED IFABOR WHEN ELEMENTS ARE MASKED
162 !| IMP_INFLOW_C |-->| LOGICAL, IMPOSED EQUILIBRIUM CONCENTRATION AT THE INFLOW OR NOT
163 !| IT1 |<->| INTEGER WORK ARRAY IN A BIEF_OBJ STRUCTURE
164 !| IT2 |<->| INTEGER WORK ARRAY IN A BIEF_OBJ STRUCTURE
165 !| IT3 |<->| INTEGER WORK ARRAY IN A BIEF_OBJ STRUCTURE
166 !| IT4 |<->| INTEGER WORK ARRAY IN A BIEF_OBJ STRUCTURE
167 !| KARMAN |-->| VON KARMAN CONSTANT
168 !| KDDL |-->| CONVENTION FOR DEGREE OF FREEDOM
169 !| KDIR |-->| CONVENTION FOR DIRICHLET POINT
170 !| KENT |-->| CONVENTION FOR LIQUID INPUT WITH PRESCRIBED VALUE
171 !| KLOG |-->| CONVENTION FOR SOLID BOUNDARY
172 !| KNEU |-->| CONVENTION FOR NEUMANN CONDITION
173 !| KS |-->| TOTAL BED ROUGHNESS
174 !| KSORT |-->| CONVENTION FOR FREE OUTPUT
175 !| KSP |-->| SKIN BED ROUGHNESS
176 !| KSR |-->| RIPPLE BED ROUGHNESS
177 !| KX |<->| COEFFICIENTS OF THE DISPERSION TENSOR (DIM. NPOIN)
178 !| KY |<->| COEFFICIENTS OF THE DISPERSION TENSOR (DIM. NPOIN)
179 !| KZ |<->| COEFFICIENTS OF THE DISPERSION TENSOR (DIM. NPOIN)
180 !| LICBOR |-->| BOUNDARY CONDITIONS FOR SEDIMENT
181 !| LIMDIF |<->| BOUNDARY CONDITIONS FOR DIFFUSION
182 !| LT |-->| ITERATION
183 !| MASDEP |<--| TOTAL DEPOSITED MASS
184 !| MASDEPT |<--| DEPOSITED MASS DURING THE TIME STEP
185 !| MASED0 |<->| SUSPENDED MASS BALANCE
186 !| MASFIN |<--| MASS AT THE END
187 !| MASINI |<->| INITIAL MASS
188 !| MASKEL |-->| MASKING OF ELEMENTS
189 !| MASKPT |-->| MASKING PER POINT
190 !| MASKTR |<->| MASKING FOR TRACERS, PER POINT
191 !| MASSOU |<--| MASS OF TRACER ADDED BY SOURCE TERM
192 !| | | SEE DIFSOU
193 !| MASTCP |<--| ??? NE SERT A RIEN, A SUPPRIMER
194 !| MASTEN |<->| MASS ENTERED THROUGH LIQUID BOUNDARY
195 !| MASTOU |<->| MASS CREATED BY SOURCE TERM
196 !| MAXADV |-->| MAXIMUM NUMBER OF ITERATIONS FOR ADVECTION SCHEMES
197 !| MBOR |<->| MATRIX OBJECT
198 !| MESH |<->| MESH STRUCTURE
199 !| MIXTE |-->| LOGICAL, MIXTE SEDIMENT OR NOT
200 !| MSK |-->| IF YES, THERE IS MASKED ELEMENTS
201 !| MS_SABLE |<->| MASS OF SAND PER LAYER (KG/M2)
202 !| MS_VASE |<->| MASS OF MUD PER LAYERv (KG/M2)
203 !| MU |-->| CORRECTION FACTOR FOR BED ROUGHNESS
204 !| NOMBLAY |-->| NUMBER OF LAYERS FOR CONSOLIDATION
205 !| NFRLIQ |-->| NUMBER OF LIQUID BOUNDARIES
206 !| NIT |-->| TOTAL NUMBER OF ITERATIONS
207 !| NPOIN |-->| NUMBER OF POINTS
208 !| NPTFR |-->| NUMBER OF BOUNDARY POINTS
209 !| NSICLA |-->| NUMBER OF SIZE CLASSES FOR BED MATERIALS
210 !| NUMLIQ |-->| LIQUID BOUNDARY NUMBER OF BOUNDARY POINTS
211 !| OPDTRA |-->| OPTION FOR THE DIFFUSION OF TRACERS
212 !| OPTBAN |-->| OPTION FOR THE TREATMENT OF TIDAL FLATS
213 !| OPTDIF |-->| OPTION FOR THE DISPERSION
214 !| OPTADV |-->| SCHEME OPTION FOR ADVECTION
215 !| PARTHENIADES |-->| CONSTANT OF THE KRONE AND PARTHENIADES EROSION LAW (M/S)
216 !| PASS |<->| IN FACT PASS_SUSP IN SISYPHE.F, ARRIVES AS .TRUE.
217 !| | | AT FIRST CALL AND IS CHANGED INTO .FALSE. BELOW
218 !| QSCLXS |<->| SUSPENDED LOAD TRANSPORT RATE FOR EACH CLASS X-DIRECTION
219 !| QSCLYS |<->| SUSPENDED LOAD TRANSPORT RATE FOR EACH CLASS Y-DIRECTION
220 !| QSCL_S |<->| SUSPENDED LOAD TRANSPORT RATE
221 !| QSXS |<->| SOLID DISCHARGE X (SUSPENSION)
222 !| QSYS |<->| SOLID DISCHARGE Y (SUSPENSION)
223 !| QS_C |-->| BEDLOAD TRANSPORT RATE
224 !| QS_S |<->| SUSPENDED LOAD TRANSPORT RATE
225 !| RESOL |-->| CHOICE OF ADVECTION SCHEME
226 !| S |<->| VOID STRUCTURE
227 !| SEDCO |-->| LOGICAL, SEDIMENT COHESIVE OR NOT
228 !| SLVTRA |<->| SLVCFG STRUCTURE
229 !| SOLSYS |-->| SLVCFG STRUCTURE
230 !| T1 |<->| WORK BIEF_OBJ STRUCTURE
231 !| T10 |<->| WORK BIEF_OBJ STRUCTURE
232 !| T11 |<->| WORK BIEF_OBJ STRUCTURE
233 !| T12 |<->| WORK BIEF_OBJ STRUCTURE
234 !| T2 |<->| WORK BIEF_OBJ STRUCTURE
235 !| T3 |<->| WORK BIEF_OBJ STRUCTURE
236 !| T4 |<->| WORK BIEF_OBJ STRUCTURE
237 !| T5 |<->| WORK BIEF_OBJ STRUCTURE
238 !| T6 |<->| WORK BIEF_OBJ STRUCTURE
239 !| T7 |<->| WORK BIEF_OBJ STRUCTURE
240 !| T8 |<->| WORK BIEF_OBJ STRUCTURE
241 !| T9 |<->| WORK BIEF_OBJ STRUCTURE
242 !| TB |-->| BLOCK OF WORKING ARRAYS
243 !| TE1 |<->| WORKING ARRAY FOR ELEMENTS
244 !| TE2 |<->| WORKING ARRAY FOR ELEMENTS
245 !| TE3 |<->| WORKING ARRAY FOR ELEMENTS
246 !| TETA_SUSP |<->| IMPLICITATION FACTOR FOR THE DEPOSITION FLUX AND DIFFUSION
247 !| TOB |-->| BED SHEAR STRESS (TOTAL FRICTION)
248 !| TOCE_SABLE |<->| CRITICAL SHEAR STRESS FOR SAND (N/M2)
249 !| TOCE_MIXTE |<->| CRITICAL SHEAR STRESS FOR MIXED SEDIMENTS (N/M2)
250 !| TOCE_VASE |<->| CRITICAL EROSION SHEAR STRESS OF THE MUD PER LAYER (N/M2)
251 !| U2D |-->| MEAN FLOW VELOCITY X-DIRECTION
252 !| UCONV |<->| X-COMPONENT ADVECTION FIELD (SISYPHE)
253 !| UCONV_TEL |-->| X-COMPONENT ADVECTION FIELD (TELEMAC)
254 !| UNSV2D |-->| INVERSE OF INTEGRALS OF TEST FUNCTIONS
255 !| V2D |-->| MEAN FLOW VELOCITY Y-DIRECTION
256 !| V2DPAR |-->| INTEGRAL OF TEST FUNCTIONS, ASSEMBLED IN PARALLEL
257 !| VCE |-->| FLOW VISCOSITY
258 !| VCONV |<->| Y-COMPONENT ADVECTION FIELD (SISYPHE)
259 !| VCONV_TEL |-->| Y-COMPONENT ADVECTION FIELD (TELEMAC)
260 !| VISC_TEL |-->| VELOCITY DIFFUSIVITY (TELEMAC)
261 !| VITCD |-->| CRITICAL SHEAR VELOCITY FOR MUD DEPOSITION
262 !| VOLU2D |-->| INTEGRAL OF BASES
263 !| XKX |-->| COEFFICIENT USED FOR COMPUTING THE DISPERSION
264 !| | | DEPENDS OF OPTIONS
265 !| XKY |-->| COEFFICIENT USED FOR COMPUTING THE DISPERSION
266 !| | | DEPENDS OF OPTIONS
267 !| XMVE |-->| FLUID DENSITY
268 !| XMVS |-->| SEDIMENT DENSITY
269 !| XWC |-->| SETTLING VELOCITIES PER CLASS OF SEDIMENT
270 !| ZCONV |-->| THE PIECE-WISE CONSTANT PART OF ADVECTION FIELD
271 !| | | IS DM1*GRAD(ZCONV)
272 !| ZERO |-->| ZERO
273 !| ZF |-->| ELEVATION OF BOTTOM
274 !| ZFCL_S |<->| BED EVOLUTION PER CLASS, DUE TO SUSPENDED SEDIMENT
275 !| ZF_S |<->| ACCUMULATED BED EVOLUTION DUE TO SUSPENDED SEDIMENT
276 !| ZREF |-->| REFERENCE ELEVATION
277 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
278 !
279  USE interface_sisyphe,ex_suspension_main => suspension_main
280  USE bief
282  USE interface_parallel, ONLY : p_dsum
283  IMPLICIT NONE
284 !
285  ! 2/ GLOBAL VARIABLES
286  ! -------------------
287  type(slvcfg), INTENT(INOUT) :: slvtra
288  type(bief_obj), INTENT(IN) :: hn,hn_tel,mu,tob
289  type(bief_obj), INTENT(IN) :: ksp,ksr,ks
290  type(bief_obj), INTENT(IN) :: volu2d,afbor,bfbor,zf
291  type(bief_obj), INTENT(IN) :: v2dpar,unsv2d
292  type(bief_obj), INTENT(IN) :: licbor, ifamas, maskel, maskpt
293  type(bief_obj), INTENT(IN) :: u2d, v2d,dm1,zconv,flbor_tel
294  INTEGER, INTENT(IN) :: NSICLA, NPOIN, NPTFR, IELMT
295  INTEGER, INTENT(IN) :: OPTDIF, RESOL,LT, NIT
296  INTEGER, INTENT(IN) :: OPTBAN,OPTADV,OPDTRA,NFRLIQ
297  INTEGER, INTENT(IN) :: KENT, KSORT, KLOG, KNEU
298  INTEGER, INTENT(IN) :: KDIR,KDDL
299  INTEGER, INTENT(IN) :: DEBUG,SOLSYS,NOMBLAY,MAXADV
300  INTEGER, INTENT(IN) :: NUMLIQ(nptfr)
301  DOUBLE PRECISION, INTENT(IN) :: DTS,CSF_SABLE
302  DOUBLE PRECISION, INTENT(IN) :: ZERO,GRAV
303  DOUBLE PRECISION, INTENT(IN) :: FDM(nsicla),FD90(nsicla)
304  DOUBLE PRECISION, INTENT(IN) :: XKX,XKY,KARMAN,VCE
305  DOUBLE PRECISION, INTENT(IN) :: XMVE, XMVS, HMIN, XWC(nsicla)
306  DOUBLE PRECISION, INTENT(IN) :: VITCD
307  DOUBLE PRECISION, INTENT(IN) :: PARTHENIADES
308  LOGICAL, INTENT(IN) :: BILMA, MSK, CHARR
309  LOGICAL, INTENT(IN) :: IMP_INFLOW_C
310  LOGICAL, INTENT(IN) :: SEDCO(nsicla),MIXTE
311  TYPE(bief_mesh), INTENT(INOUT) :: MESH
312  type(bief_obj), INTENT(INOUT) :: zf_s,cs,cst,ctild,cbor
313  type(bief_obj), INTENT(INOUT) :: disp,it1,it2,it3,it4,tb
314  type(bief_obj), INTENT(INOUT) :: t1,t2,t3,t4,t8
315  type(bief_obj), INTENT(INOUT) :: t9,t10,t11,t12,t14,te1,clt
316  type(bief_obj), INTENT(INOUT) :: te2,te3,s,am1_s,am2_s,mbor
317  type(bief_obj), INTENT(INOUT) :: elay, limdif,flbortra
318  type(bief_obj), INTENT(INOUT) :: masktr
319  DOUBLE PRECISION, INTENT(INOUT) :: TETA_SUSP, AC(nsicla)
320  DOUBLE PRECISION, INTENT(INOUT) :: MASED0(nsicla), MASINI(nsicla)
321  DOUBLE PRECISION, INTENT(INOUT) :: MASTEN(nsicla), MASTOU(nsicla)
322  DOUBLE PRECISION, INTENT(INOUT) :: ES(npoin,nomblay)
323  DOUBLE PRECISION, INTENT(INOUT) :: ES_SABLE(npoin,nomblay)
324  DOUBLE PRECISION, INTENT(INOUT) :: ES_VASE(npoin,nomblay)
325  DOUBLE PRECISION, INTENT(INOUT) :: CONC(npoin,nomblay)
326  DOUBLE PRECISION, INTENT(INOUT) :: TOCE_VASE(nomblay)
327  DOUBLE PRECISION, INTENT(INOUT) :: TOCE_SABLE
328  DOUBLE PRECISION, INTENT(INOUT) :: AVAIL(npoin,nomblay,nsicla)
329  LOGICAL, INTENT(INOUT) :: ENTETS, PASS
330  type(bief_obj), INTENT(INOUT) :: zfcl_s,hprop,zref
331  type(bief_obj), INTENT(INOUT) :: fludpt,fludp,fluer
332  type(bief_obj), INTENT(INOUT) :: disp_c,kx,ky,kz,uconv
333  type(bief_obj), INTENT(INOUT) :: vconv,flbor_sis
334  type(bief_obj), INTENT(INOUT) :: qsxs,qsys,qsclxs,qsclys
335  type(bief_obj), INTENT(INOUT) :: qscl_s,qs_s,cstaeq,csratio
336  type(bief_obj), INTENT(INOUT) :: fluer_vase,toce_mixte
337  type(bief_obj), INTENT(INOUT) :: ms_sable,ms_vase
338  type(bief_obj), INTENT(IN) :: qs_c,visc_tel
339  type(bief_obj), INTENT(IN) :: uconv_tel,vconv_tel
340  DOUBLE PRECISION, INTENT(OUT) :: MASTCP(nsicla),MASFIN(nsicla)
341  DOUBLE PRECISION, INTENT(OUT) :: MASDEPT(nsicla),MASDEP(nsicla)
342  DOUBLE PRECISION, INTENT(OUT) :: MASSOU
343  INTEGER, INTENT(IN) :: ICQ,DIRFLU
344  LOGICAL, INTENT (IN) :: CORR_CONV,DIFT
345  CHARACTER(LEN=24), INTENT(IN) :: CODE
346 !
347  ! 3/ LOCAL VARIABLES
348  ! ------------------
349  INTEGER :: I,J
350 !
351 !======================================================================!
352 ! PROGRAM !
353 !======================================================================!
354 !======================================================================!
355 !
356  IF(pass) THEN
357 !
358  ! ************************* !
359  ! III - INITIAL MASS-BALANCE !
360  ! ************************* !
361 !
362  IF(bilma) THEN
363  DO i = 1,nsicla
364 ! MUST BE DONE LIKE IN SUSPENSION_BILAN
365 ! I.E. WITH MASS-LUMPING AGGLOT=1. WHICH IS
366 ! SET LATER IN SUSPENSION_COMPUTATION...
367  CALL os('X=YZ ',x=t1,y=volu2d,z=cs%ADR(i)%P)
368 !
369  IF(code(1:7).EQ.'TELEMAC') THEN
370 ! WITH COUPLING, HN-TEL IS THE OLD DEPTH
371 ! HN IS THE NEW DEPTH
372  mased0(i) = dots(t1,hn_tel)
373  ELSE
374 ! SISYPHE WITHOUT COUPLING, MASS CONSERVATION
375 ! DIFFICULT TO CHECK...
376  mased0(i) = dots(t1,hn)
377  ENDIF
378  IF(ncsize.GT.1) mased0(i)=p_dsum(mased0(i))
379  masini(i) = mased0(i)
380  masten(i) = 0.d0
381  mastou(i) = 0.d0
382  mastcp(i) = 0.d0
383  WRITE(lu,2) i, mased0(i)
384  ENDDO
385  ENDIF
386 !
387  !----------------------------------------------------------------!
388 002 FORMAT(1x,'INITIAL QUANTITY IN SUSPENSION FOR CLASS ',
389  & i2,' : ', g16.7, ' M3')
390  !----------------------------------------------------------------!
391 ! END OF IF(PASS)
392  ENDIF
393 !
394  pass = .false.
395 !
396  ! ********************************* !
397  ! V - COMPUTES THE DISPERSION !
398  ! ********************************* !
399  IF (debug > 0) WRITE(lu,*) 'SUSPENSION_DISPERSION'
401  & (tob,xmve,hn,optdif,npoin,xkx,xky,t1,t2,t3,kx,ky,kz,disp,
402  & u2d,v2d,visc_tel,code)
403  IF (debug > 0) WRITE(lu,*) 'END_SUSPENSION_DISPERSION'
404 
405  ! ************************************************ !
406  ! VI - COMPUTES THE CONCENTRATION AND EVOLUTION !
407  ! ************************************************ !
408 
409  IF(code(1:7).EQ.'TELEMAC') THEN
410  CALL os('X=Y ', x=hprop, y=hn_tel)
411  ELSE
412  CALL os('X=Y ', x=hprop, y=hn)
413  ENDIF
414  DO i = 1, nsicla
415  CALL os('X=0 ', x=zfcl_s%ADR(i)%P)
416  IF(debug > 0) WRITE(lu,*)
417  & 'SUSPENSION_COMPUTATION : ',i,'/',nsicla
418  CALL suspension_computation(slvtra,hn,hn_tel,uconv,
419  &vconv,mu,tob,fdm(i),fd90(i),ksp,ksr,ks,elay,avail(1:npoin,1,i),
420  &afbor,bfbor,limdif,clt,maskel,masktr,maskpt,ifamas,npoin,ielmt,
421  &nptfr,i,lt,nit,resol,optban,kent,kddl,kdir,ksort,klog,kneu,
422  &optadv,opdtra,debug, csf_sable, teta_susp,dts,
423  &mased0(i),zero,xwc(i),karman,xmve,xmvs,vce,grav,hmin,vitcd,
424  &partheniades,entets,bilma,
425  &msk,charr,imp_inflow_c,mesh,zf,cs%ADR(i)%P,
426  &cst%ADR(i)%P,ctild%ADR(i)%P,cbor%ADR(i)%P,disp,it1,it2,
427  &it3,it4,tb,t1,t2,t3,t4,t8,t9,t10,t11,t12,t14,
428  &te1,te2,te3,s,am1_s,am2_s,mbor,masten(i),mastou(i),
429  &masini(i),ac(i),zfcl_s%ADR(i)%P,fludpt%ADR(i)%P,fludp%ADR(i)%P,
430  &fluer%ADR(i)%P, hprop,disp_c,cstaeq, csratio,
431  &masfin(i),masdept(i),masdep(i),massou,qs_c,icq,zref,
432  &corr_conv,u2d,v2d,sedco(i),dift,dm1,zconv,uconv_tel,
433  &vconv_tel,solsys,flbor_tel,flbor_sis,flbortra,code,volu2d,
434  &v2dpar,unsv2d,numliq,nfrliq,licbor,mixte,avail,nsicla,es,
435  &es_sable,es_vase,nomblay,conc,toce_vase,toce_sable,
436  &fluer_vase,toce_mixte,ms_sable%R,ms_vase%R,dirflu,
437  &qsclxs%ADR(i)%P,qsclys%ADR(i)%P,maxadv)
438  IF (debug > 0) WRITE(lu,*) 'END_SUSPENSION_COMPUTATION'
439 !
440  ENDDO
441 !
442 ! FOR MIXTE OR COHESIVE SEDIMENTS ELAY UPDATED
443 !
444 ! REACTUALISATION DU ELAY ET DES AVAI fait dans suspension_MAIN
445  IF(sedco(1).OR.mixte) THEN
446  DO i = 1, npoin
447  elay%R(i)= 0.d0
448  DO j= 1, nomblay
449  es(i,j) = es_vase(i,j)
450  IF(mixte) THEN
451  es(i,j)= es_vase(i,j) + es_sable(i,j)
452  IF(es(i,j).GT.1.d-04) THEN
453  avail(i,j,1)= es_sable(i,j)/es(i,j)
454  avail(i,j,2)= es_vase(i,j)/es(i,j)
455 !CVL ELSE
456 !CVL AVAIL(I,J,1)=0.5 D0
457 !CVL AVAIL(I,J,2)=0.5 D0
458  ENDIF
459  ENDIF
460  elay%R(i)=elay%R(i)+es(i,j)
461  ENDDO
462  ENDDO
463  ENDIF
464 !
465  ! *********************************************************** !
466  ! VII - UPDATES EVOLUTION, CONCENTRATION AND TRANSPORT RATE !
467  ! *********************************************************** !
468 !
469  IF (debug > 0) WRITE(lu,*) 'UPDATING_DATA'
470 !
471 ! COULD BE OPTIMISED: FIRST CLASS ON ZF_S, THEN ADDING OTHERS...
472 !
473  CALL os('X=0 ', x=qsxs)
474  CALL os('X=0 ', x=qsys)
475  CALL os('X=0 ', x=zf_s)
476 !
477  DO i = 1, nsicla
478  CALL os('X=X+Y ', x=zf_s, y=zfcl_s%ADR(i)%P)
479  CALL os('X=X+Y ', x=qsxs, y=qsclxs%ADR(i)%P)
480  CALL os('X=X+Y ', x=qsys, y=qsclys%ADR(i)%P)
481  ENDDO
482  CALL os('X=N(Y,Z)', x=qscl_s, y=qsclxs, z=qsclys)
483  CALL os('X=N(Y,Z)', x=qs_s, y=qsxs, z=qsys)
484  IF (debug > 0) WRITE(lu,*) 'END_UPDATING_DATA'
485 !
486 !======================================================================!
487 !======================================================================!
488 !
489  RETURN
490  END
subroutine suspension_computation(SLVTRA, HN, HN_TEL, UCONV, VCONV, MU, TOB, FDM, FD90, KSP, KSR, KS, ELAY, AVA, AFBOR, BFBOR, LIMDIF, CLT, MASKEL, MASKTR, MASKPT, IFAMAS, NPOIN, IELM, NPTFR, ITRA, LT, NIT, RESOL, OPTBAN, KENT, KDDL, KDIR, KSORT, KLOG, KNEU, OPTADV, OPDTRA, DEBUG, CSF_SABLE, TETA_SUSP, DT, MASED0, ZERO, XWC, KARMAN, XMVE, XMVS, VCE, GRAV, HMIN, VITCD, PARTHENIADES, ENTETS, BILMA, MSK, CHARR, IMP_INFLOW_C, MESH, ZF, CS, CST, CTILD, CBOR, DISP, IT1, IT2, IT3, IT4, TB, T1, T2, T3, T4, T8, T9, T10, T11, T12, T14, TE1, TE2, TE3, S, AM1_S, AM2_S, MBOR, MASTEN, MASTOU, MASINI, AC, ZFCL_S, FLUDPT, FLUDP, FLUER, HPROP, DISP_C, CSTAEQ, CSRATIO, MASFIN, MASDEPT, MASDEP, MASSOU, QS_C, ICQ, ZREF, CORR_CONV, U2D, V2D, SEDCO, DIFT, DM1, ZCONV, UCONV_TEL, VCONV_TEL, SOLSYS, FLBOR_TEL, FLBOR_SIS, FLBORTRA, CODE, VOLU2D, V2DPAR, UNSV2D, NUMLIQ, NFRLIQ, LICBOR, MIXTE, AVAIL, NSICLA, ES, ES_SABLE, ES_VASE, NOMBLAY, CONC, TOCE_VASE, TOCE_SABLE, FLUER_VASE, TOCE_MIXTE, MS_SABLE, MS_VASE, DIRFLU, QSCLXS, QSCLYS, MAXADV)
double precision function dots(X, Y)
Definition: dots.f:7
double precision function p_dsum(MYPART)
Definition: p_dsum.F:7
subroutine suspension_main(SLVTRA, HN, HN_TEL, MU, TOB, FDM, FD90, KSP, KSR, KS, VOLU2D, V2DPAR, UNSV2D, AFBOR, BFBOR, ZF, LICBOR, IFAMAS, MASKEL, MASKPT, U2D, V2D, NSICLA, NPOIN, NPTFR, IELMT, OPTDIF, RESOL, LT, NIT, OPTBAN, OPTADV, OPDTRA, KENT, KSORT, KLOG, KNEU, KDIR, KDDL, DEBUG, DTS, CSF_SABLE, ZERO, GRAV, XKX, XKY, KARMAN, XMVE, XMVS, VCE, HMIN, XWC, VITCD, PARTHENIADES, BILMA, MSK, CHARR, IMP_INFLOW_C, MESH, ZF_S, CS, CST, CTILD, CBOR, DISP, IT1, IT2, IT3, IT4, TB, T1, T2, T3, T4, T8, T9, T10, T11, T12, T14, TE1, CLT, TE2, TE3, S, AM1_S, AM2_S, MBOR, ELAY, LIMDIF, MASKTR, TETA_SUSP, AC, MASED0, MASINI, MASTEN, MASTOU, ES, ES_SABLE, ES_VASE, AVAIL, ENTETS, PASS, ZFCL_S, HPROP, FLUDPT, FLUDP, FLUER, DISP_C, KX, KY, KZ, UCONV, VCONV, QSXS, QSYS, QSCLXS, QSCLYS, QSCL_S, QS_S, QS_C, CSTAEQ, CSRATIO, ICQ, MASTCP, MASFIN, MASDEPT, MASDEP, MASSOU, CORR_CONV, ZREF, SEDCO, VISC_TEL, CODE, DIFT, DM1, UCONV_TEL, VCONV_TEL, ZCONV, SOLSYS, FLBOR_TEL, FLBOR_SIS, FLBORTRA, NUMLIQ, NFRLIQ, MIXTE, NOMBLAY, CONC, TOCE_VASE, TOCE_SABLE, FLUER_VASE, TOCE_MIXTE, MS_SABLE, MS_VASE, DIRFLU, MAXADV)
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
subroutine suspension_dispersion
Definition: bief.f:3