The TELEMAC-MASCARET system  trunk
init_transport_gaia.f
Go to the documentation of this file.
1 ! ******************************
2  SUBROUTINE init_transport_gaia
3 ! ******************************
4 !
5  &(hiding,nsicla,npoin,t1,t2,t3,t4,t5,t6,t7,t8,t9,
6  & t10,t11,t12,t14,charr,qs_c,qsxc,qsyc,calfa_cl,salfa_cl,
7  & coefpn,slopeff,susp,qs,qscl,qscl_c,qscl_s,unorm,u2d,v2d,hn,cf,mu,
8  & tob,tobw,uw,tw,thetaw,fw,houle,acladm,unladm,ksp,ksr,
9  & icf,hidfac,xmvs0,xmve,grav,vce,hmin,karman,zero,pi,ac,cstaeq,
10  & seccurrent,bijk,ielmt,mesh,dcla,xwc,sedco,u3d,v3d,code,h_tel,
11  & hw,thetac,tobcw_mean,tobcw_max)
12 !
13 !***********************************************************************
14 ! GAIA
15 !***********************************************************************
16 !
18 !
19 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
93 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
94 !
95  USE bief
96  USE interface_gaia, ex_init_transport => init_transport_gaia
97 !
99  & ratio_sand,sanfra,csratio,nsand
100 !
102  IMPLICIT NONE
103 !
104 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
105 !
106  INTEGER, INTENT(IN) :: NSICLA,NPOIN
107  INTEGER, INTENT(IN) :: ICF,HIDFAC,IELMT,SLOPEFF
108  LOGICAL, INTENT(IN) :: CHARR,SUSP,HOULE
109  LOGICAL, INTENT(IN) :: SECCURRENT,SEDCO(*)
110  TYPE(bief_obj), INTENT(IN) :: U2D,V2D,UNORM,HN,CF
111  TYPE(bief_obj), INTENT(IN) :: MU,TOB,TOBW,UW,TW,THETAW,FW
112  TYPE(bief_obj), INTENT(IN) :: ACLADM,UNLADM,KSP,KSR
113  TYPE(bief_obj), INTENT(IN) :: H_TEL
114  TYPE(bief_obj), INTENT(INOUT) :: HIDING,CSTAEQ
115  TYPE(bief_obj), INTENT(INOUT) :: QS_C, QSXC, QSYC
116  TYPE(bief_obj), INTENT(INOUT) :: CALFA_CL,SALFA_CL
117  TYPE(bief_obj), INTENT(INOUT) :: T1,T2,T3,T4,T5,T6,T7,T8
118  TYPE(bief_obj), INTENT(INOUT) :: T9,T10,T11,T12,T14
119  TYPE(bief_obj), INTENT(INOUT) :: QS,QSCL_C,QSCL_S
120  TYPE(bief_obj), INTENT(INOUT) :: COEFPN
121  TYPE(bief_obj), INTENT(INOUT) :: QSCL
122  TYPE(bief_mesh), INTENT(INOUT) :: MESH
123  DOUBLE PRECISION, INTENT(IN) :: XMVS0(nsicla),XMVE,GRAV,VCE
124  DOUBLE PRECISION, INTENT(IN) :: HMIN,KARMAN,ZERO,PI
125  DOUBLE PRECISION, INTENT(IN) :: BIJK,XWC(nsicla)
126  DOUBLE PRECISION, INTENT(INOUT) :: AC(nsicla),DCLA(nsicla)
127 !
128  TYPE(bief_obj), INTENT(IN) :: U3D,V3D
129  CHARACTER(LEN=24), INTENT(IN) :: CODE
130 !
131  TYPE(bief_obj), INTENT(IN) :: HW, THETAC
132  TYPE(bief_obj), INTENT(INOUT) :: TOBCW_MEAN, TOBCW_MAX
133 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
134 !
135  INTEGER I,J,K
136  DOUBLE PRECISION U3DNORM
137  DOUBLE PRECISION, ALLOCATABLE :: TMP_RATIO(:)
138 !
139 !======================================================================!
140 !======================================================================!
141 ! PROGRAM !
142 !======================================================================!
143 !======================================================================!
144 !
145 ! --- START : INITIALISES RATE OF TRANSPORT AND SUSPENSION
146 !
147 ! FOR INITIALISATION : SLOPE EFFECT AND DEVIATION ARE CANCELLED
148 !
149 ! RK in case of coupling with T3D, the direction should
150 ! come from the bottom velocity
151 !
152 ! Calculation of sand fraction content at each node (Wilcock and Crowe, 2003)
153  IF (icf == 10) THEN
154  DO k = 1, npoin
155  sanfra(k) = 0.0d0
156  DO i = 1, nsand
157  IF (dcla(i).LT.2d-3) THEN
158  sanfra(k) = sanfra(k) + ratio_sand(i,1,k)
159  ENDIF
160  ENDDO
161  ENDDO
162  ENDIF
163 !
164  IF(code(1:9).EQ.'TELEMAC3D') THEN
165  DO i=1,npoin
166  u3dnorm=sqrt(u3d%R(i)*u3d%R(i)+v3d%R(i)*v3d%R(i))
167  IF(u3dnorm.GE.1.d-12) THEN
168  calfa_cl%ADR(1)%P%R(i)=u3d%R(i)/u3dnorm
169  salfa_cl%ADR(1)%P%R(i)=v3d%R(i)/u3dnorm
170  ELSE
171  calfa_cl%ADR(1)%P%R(i)=1.d0
172  salfa_cl%ADR(1)%P%R(i)=0.d0
173  ENDIF
174  ENDDO
175  ELSE
176  CALL os('X=Y/Z ',x=calfa_cl%ADR(1)%P, y=u2d, z=unorm,
177  & c=0.d0, iopt=2, infini=1.d0, zero=1.d-12)
178  CALL os('X=Y/Z ',x=salfa_cl%ADR(1)%P, y=v2d, z=unorm,
179  & c=0.d0, iopt=2, infini=0.d0, zero=1.d-12)
180  ENDIF
181  IF(nsicla.GT.1) THEN
182  DO i=2,nsicla
183  CALL os('X=Y ', x=calfa_cl%ADR(i)%P,
184  & y=calfa_cl%ADR(1)%P)
185  CALL os('X=Y ', x=salfa_cl%ADR(i)%P,
186  & y=salfa_cl%ADR(1)%P)
187  ENDDO
188  ENDIF
189 !
190 ! appel a effpnt ?
191 !
192  CALL os('X=C ',x=coefpn,c=1.d0)
193 !
194  IF(charr) THEN
195 !
196 ! MPM for each Layer
197 !
198  CALL os('X=C ', x=mpm_aray, c=mpm)
199 !
200  CALL os('X=C ',x=hiding,c=1.d0)
201 !
202  ALLOCATE(tmp_ratio(npoin))
203  DO i = 1, nsicla
204 !
205  IF(sedco(i)) THEN
206 ! IF COHESIVE: NO BEDLOAD TRANSPORT
207  CALL os('X=0 ', x=qscl_c%ADR(i)%P)
208  ELSE
209 ! IF NON COHESIVE
210  tmp_ratio = ratio_sand(num_icla_isand(i),1,1:npoin)
212  & (u2d,v2d,unorm,hn,cf,mu,tob,tobw,uw,tw,thetaw,fw,
213  & acladm, unladm,ksp,ksr,
214  & tmp_ratio,
215  & npoin,icf,hidfac,xmvs0(i),xmve,
216  & dcla(i),grav,vce,hmin,xwc(i),karman,zero,
217  & pi,susp,ac(i),hiding,t1,t2,t3,t4,t5,t6,t7,t8,t9,t10,
218  & t11,t12,qscl_c%ADR(i)%P,qscl_s%ADR(i)%P,
219  & ielmt,seccurrent,slopeff,
220  & coefpn,calfa_cl%ADR(i)%P,salfa_cl%ADR(i)%P,
221  & bijk,houle,h_tel,
222  & hw,thetac,tobcw_mean,tobcw_max,cstaeq%ADR(i)%P,
223  & sanfra)
224 !
225  ENDIF
226 ! SUM ON ALL CLASSES
227  DO j=1,npoin
228  qs_c%R(j) = qs_c%R(j) + qscl_c%ADR(i)%P%R(j)
229 !
230 ! COMPUTES THE X AND Y COMPONENTS OF TRANSPORT
231  qsxc%R(j) = qsxc%R(j) + qscl_c%ADR(i)%P%R(j)
232  & *calfa_cl%ADR(i)%P%R(j)
233  qsyc%R(j) = qsyc%R(j) + qscl_c%ADR(i)%P%R(j)
234  & *salfa_cl%ADR(i)%P%R(j)
235  ENDDO
236 !
237  ENDDO
238  DEALLOCATE(tmp_ratio)
239 !
240 !
241  ENDIF
242 !
243 !
244 ! COMPUTES THE TRANSPORT FOR EACH CLASS (IF NOT RESTART OR IF
245 ! DATA NOT FOUND)
246  DO i=1, nsicla
247  WRITE(lu,*) 'QSCL REINITIALISED IN INIT_TRANSPORT_GAIA'
248  WRITE(lu,*) 'FOR CLASS ',i
249  CALL os('X=Y ',x=qscl%ADR(i)%P,y=qscl_c%ADR(i)%P)
250  ENDDO
251 !
252 ! COMPUTES TOTAL TRANSPORT QS
253 !
254  WRITE(lu,*) 'QS REINITIALISED IN INIT_TRANSPORT_GAIA'
255  CALL os('X=Y ',x=qs,y=qs_c)
256 !
257 !-----------------------------------------------------------------------
258 !
259 ! INITIALISE CSRATIO
260  csratio%R = 1d0
261 !
262  RETURN
263  END
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 init_transport_gaia(HIDING, NSICLA, NPOIN, T1, T2, T3, T4, T5, T6, T7, T8, T9, T10, T11, T12, T14, CHARR, QS_C, QSXC, QSYC, CALFA_CL, SALFA_CL, COEFPN, SLOPEFF, SUSP, QS, QSCL, QSCL_C, QSCL_S, UNORM, U2D, V2D, HN, CF, MU, TOB, TOBW, UW, TW, THETAW, FW, HOULE, ACLADM, UNLADM, KSP, KSR, ICF, HIDFAC, XMVS0, XMVE, GRAV, VCE, HMIN, KARMAN, ZERO, PI, AC, CSTAEQ, SECCURRENT, BIJK, IELMT, MESH, DCLA, XWC, SEDCO, U3D, V3D, CODE, H_TEL, HW, THETAC, TOBCW_MEAN, TOBCW_MAX)
type(bief_obj), target mpm_aray
Meyer Peter Mueller factor.
integer, dimension(:), allocatable num_icla_isand
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
double precision, target mpm
Meyer Peter Mueller-Coefficient.
Definition: bief.f:3