The TELEMAC-MASCARET system  trunk
prep_advection_gaia.f
Go to the documentation of this file.
1 ! ******************************
2  SUBROUTINE prep_advection_gaia
3 ! ******************************
4 !
5  &(uconv_tel,vconv_tel,iconvf,solsys,j,litbor,tbor,tn,kent,flbor_w,
6  & hn_tel)
7 !
8 !***********************************************************************
9 ! GAIA
10 !***********************************************************************
11 !
13 !advection of concentration
14 !
15 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
27 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
28 !
29  USE bief
32  IMPLICIT NONE
33 !
34 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
35 !
36  TYPE(bief_obj), INTENT(IN) :: UCONV_TEL,VCONV_TEL,FLBOR_W
37  TYPE(bief_obj), INTENT(IN), TARGET :: HN_TEL
38  INTEGER, INTENT(IN) :: ICONVF,SOLSYS,J,LITBOR(nptfr),KENT
39  DOUBLE PRECISION, INTENT(INOUT) :: TBOR(nptfr),TN(npoin)
40 !
41 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
42 !
43  INTEGER :: I
44  DOUBLE PRECISION :: AUX,VITCD,FD90
45 !
46 !======================================================================!
47 ! PROGRAM !
48 !======================================================================!
49 !
50 ! MODIFY THE CONVECTIVE VELOCITY FIELD ACCORDING TO THE
51 ! CONCENTRATION PROFILE
52 !
53  CALL gaia_suspension_conv(uconv_tel,vconv_tel,iconvf,solsys,
54  & j,flbor_w)
55 !
56 ! ****************************************************
57 ! THE TOTAL FRICTION VELOCITY --> USTAR (T1)
58 ! HAS BEEN REPLACED BY USTARP (SKIN FRICTION VELOCITY)
59 ! FOR EROSION FLUX FROM V6P0 ON
60 ! ****************************************************
61 !
62  CALL os('X=CY ', x=t1, y=tobcw_mean, c=1.d0/xmve)
63 ! TOB assumed >=0, otherwise mistake elsewhere...
64  CALL os('X=SQR(Y)', x=t1, y=t1)
65 
66 ! VALUE OF D90 OF SEDIMENT
67 ! WITH ONE SAND CLASS, IT IS USER SET
68 ! WITH MORE THAN ONE SAND CLASS, IT IS
69 ! CONSIDERED AS THE RATIO BETWEEN SKIN FRICTION AND MEAN
70 ! DIAMETER * D50
71  IF (nsand.EQ.1) THEN
72  fd90 = d90
73  ELSE
74  fd90=dcla(j)*kspratio
75  ENDIF
76 !
77  IF(sedco(j)) THEN
78 
79  vitcd=sqrt(tocd_mud0(j)/xmve)
80 !
81 ! *********************************************************
82 ! IA - FORMULATION FOR COHESIVE SEDIMENTS (WITHOUT BEDLOAD)
83 ! *********************************************************
84 !
85 ! COMPUTES THE PROBABILITY FOR DEPOSITION
86 !
87  DO i = 1, npoin
88 ! HERE T1 >=0, so case TOCD_MUD0(J)=0.D0 excluded by the test
89  IF(t1%R(i).LT.vitcd) THEN
90  aux = 1.d0-(t1%R(i)/vitcd)**2
91  ELSE
92  aux = 0.d0
93  ENDIF
94 ! COMPUTES THE IMPLICIT PART OF THE DEPOSITION FLUX
95  fludpt%ADR(j)%P%R(i)= xwc(j)*aux
96  ENDDO
97 ! UNIFORM SEDIMENT ALONG THE VERTICAL
99  CALL os('X=C ', x=csratio, c=1.d0)
100 !
101 ! **********************************************************
102 ! IB - FORMULATION FOR NON-COHESIVE SEDIMENTS (WITH BEDLOAD)
103 ! **********************************************************
104 !
105  ELSE
106 !
107 ! *******************************************************
108 ! COMPUTES THE RATIO BETWEEN NEAR BED CONC. AND MEAN CONC
109 ! --> CSRATIO (TO KEEP )
110 ! *******************************************************
111 !
112 ! DMK Modification 06/05/2011
113  IF(.NOT.(set_lag)) THEN
114  IF(debug > 0) WRITE(lu,*) 'SUSPENSION_ROUSE'
116  & karman,zero,xwc(j),zref,csratio)
117  IF(debug > 0) WRITE(lu,*) 'END SUSPENSION_ROUSE'
118  ELSE
119  IF(debug > 0) WRITE(lu,*) 'SUSPENSION_BETAFACTOR'
121  & dcla(j),fd90,xwc(j),csratio)
122  IF(debug > 0) WRITE(lu,*) 'END SUSPENSION_BETAFACTOR'
123  ENDIF
124 ! End of DMK mod
125 !
126 ! ****************************************************
127 ! COMPUTES THE DEPOSITION FLUX --> FLUDPT = XWC * CSRATIO
128 ! ****************************************************
129 !
130  CALL os('X=CY ', x=fludpt%ADR(j)%P, y=csratio, c=xwc(j))
131 !
132  ENDIF
133 !
134 ! Impose the concentration at the inflow to respect the equilibrium
135 ! concentration on the boundary nodes
136 !
137  IF(imp_inflow_c) THEN
138  IF (debug > 0) WRITE(lu,*) 'IMP_INFLOW_C'
139  CALL eqcae_bc_gaia(litbor,tbor,tn,j,kent)
140  IF (debug > 0) WRITE(lu,*) 'FIN IMP_INFLOW_C'
141  ENDIF
142 !
143 ! Treatment of tidal flats
144 !
145  IF(optban.EQ.2) THEN
146  CALL os('X=XY ',x=fluer%ADR(j)%P ,y=maskpt)
147  ENDIF
148 !
149 ! Allocation des variables pour utilisation dans telemac2d
150 !
151  CALL os('X=Y ',x=hn_gai,y=hn)
152  CALL os('X=Y ',x=fluer_adv,y=fluer%ADR(j)%P)
153  CALL os('X=-Y ',x=fludpt_adv,y=fludpt%ADR(j)%P)
154 !
155  DO i=1,npoin
156  IF(hn%R(i).GT.hmin) THEN
157  fluer_adv%R(i)=fluer_adv%R(i)/hn%R(i)
158  ELSE
159  fluer_adv%R(i)=0.d0
160 ! FLUER WILL BE USED AS T11*HN, SO IT MUST BE
161 ! CANCELLED ACCORDINGLY, OTHERWISE MASS BALANCE WRONG
162  fluer%ADR(j)%P%R(i)=0.d0
163  ENDIF
164  ENDDO
165 !
166  IF(optban.NE.0) THEN
167  CALL cpstvc(hn_tel,t1)
168 ! HN_TEL IS NOT CLIPPED
169  DO i=1,npoin
170  t1%R(i)=max(hn_tel%R(i),hmin)
171  ENDDO
172  hold=>t1
173  ELSE
174  hold=>hn_tel
175  ENDIF
176 !
177 !======================================================================!
178 !======================================================================!
179 !
180  RETURN
181  END
integer, pointer nptfr
Number of boundary points.
type(bief_obj), target fludpt
Deposition flux for implicitation.
type(bief_obj), target hn_gai
double precision hmin
Minimal value of the water height: below this value, the sediment flow rate is set to 0...
type(bief_obj), target fluer_adv
double precision, dimension(nsiclm), target xwc
Settling velocities.
double precision, dimension(:), pointer x
2d coordinates of the mesh
double precision xmve
Water density (from steering file of T2D or T3D)
integer optban
Option for the treatment of tidal flats.
double precision, dimension(:), pointer y
double precision, dimension(nsiclm) tocd_mud0
Critical shear stress for mud deposition.
logical imp_inflow_c
Imposed concentration in inflow.
integer nsand
Total number of sand.
double precision zero
Parameter used for clipping variables or testing values against zero.
type(bief_obj), pointer hold
Save the water depth in the suspension computation.
subroutine suspension_rouse_gaia(USTAR, HN, NPOIN, KARMAN, ZERO, XWC, ZREF, CSRATIO)
subroutine eqcae_bc_gaia(LITBOR, TBOR, TN, J, KENT)
Definition: eqcae_bc_gaia.f:7
type(bief_obj), target hn
Water depth.
double precision, dimension(nsiclm), target dcla
Sediment diameter for each class It is only relevant for non-cohesive sediments. For the bedload...
subroutine suspension_miles_gaia(HN, NPOIN, HMIN, FDM, FD90, XWC, CSRATIO)
logical, dimension(nsiclm) sedco
Cohesive sediments (for each class)
type(bief_obj), target zref
Reference elevation.
type(bief_obj), target csratio
Ratio between bottom concentration and average concentration.
type(bief_obj), pointer t1
Aliases for work vectors in tb.
subroutine cpstvc(X, Y)
Definition: cpstvc.f:7
subroutine prep_advection_gaia(UCONV_TEL, VCONV_TEL, ICONVF, SOLSYS, J, LITBOR, TBOR, TN, KENT, FLBOR_W, HN_TEL)
double precision, target d90
Sediment diameter D90, for sand when only.
integer debug
Debugger.
double precision, target kspratio
Ratio between skin friction and mean diameter.
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
logical set_lag
Settling lag: determines choice between Rouse and Miles concentration profile SET_LAG = TRUE : Miles ...
type(bief_obj), target fludpt_adv
type(bief_obj), target fluer
Erosion flux.
type(bief_obj), target tobcw_mean
Mean of total current + wave shear stress.
subroutine gaia_suspension_conv(UCONV_TEL, VCONV_TEL, ICONVF, SOLSYS, J, FLBOR_W)
double precision karman
Karman constant.
integer, pointer npoin
Number of 2d points in the mesh.
Definition: bief.f:3
type(bief_obj), target maskpt
Mask on points.