The TELEMAC-MASCARET system  trunk
gaia_prepare_step.f
Go to the documentation of this file.
1 ! ****************************
2  SUBROUTINE gaia_prepare_step
3 ! ****************************
4  &(h_tel, u_tel, v_tel, cf_tel, charr_tel, code, deltar, dt_tel,
5  & hw_tel, ks_tel, listcount, loopcount, susp_tel,
6  & t_tel, thetaw_tel, tw_tel, uetcar, uw_tel, zf_tel)
7 !
8 !***********************************************************************
9 ! GAIA
10 !***********************************************************************
14 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
37 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
38 !
39  USE interface_gaia, ex_gaia_prepare_step =>
41  USE bief
46 !
47  IMPLICIT NONE
48 !
49 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
50 !
51  INTEGER, INTENT(IN) :: LOOPCOUNT
52  INTEGER, INTENT(IN) :: LISTCOUNT
53  CHARACTER(LEN=24), INTENT(IN) :: CODE
54  TYPE(bief_obj), INTENT(IN) :: U_TEL,V_TEL,H_TEL
55  TYPE(bief_obj), INTENT(INOUT) :: ZF_TEL,UETCAR,KS_TEL
56  TYPE(bief_obj), INTENT(IN) :: DELTAR
57  TYPE(bief_obj), INTENT(INOUT) :: CF_TEL
58  DOUBLE PRECISION, INTENT(IN) :: T_TEL
59  LOGICAL, INTENT(INOUT) :: CHARR_TEL,SUSP_TEL
60  DOUBLE PRECISION, INTENT(IN) :: DT_TEL
61  TYPE(bief_obj), INTENT(IN) :: THETAW_TEL,HW_TEL,TW_TEL
62  TYPE(bief_obj), INTENT(IN) :: UW_TEL
63 !
64 !!-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
65 !
66  INTEGER I
67 !
68 !---------------------------------------------------------------------
69 !
70  charr = charr_tel
71  susp= susp_tel
72  at0=t_tel
73 !
74  IF(debug.GT.0) WRITE(lu,*) 'GAIA STAGE 1, COMPUTE_SUSP FALSE'
75 !
76 !=======================================================================
77 !
78 ! /* LOOP ON TIME */
79 !
80 !=======================================================================
81 !---------------------------------------------------------------------
82 ! STARTS THE COMPUTATIONS
83 !---------------------------------------------------------------------
84 !
85 #if defined COMPAD
87 #endif
88 
89 !
90 !------------------------------------------------------------------
91 !
92 ! ALGORITHMIC DIFFERENTIATION
93 #if defined COMPAD
95 #endif
96 !
97 !------------------------------------------------------------------
98 !
99 ! DETERMINES THE TIME STEP AND THE TIMESTEP NUMBER
100 !
101  dt=dt_tel*mofac
102  lt = loopcount
103 !
104 ! PRINTOUTS TO LISTING :
105 !
106  IF(listcount*(lt/listcount).EQ.lt) THEN
107  entet = .true.
108  ELSE
109  entet = .false.
110  ENDIF
111 !
112 ! FORCE CUSTOM WAVE CONDITIONS
113 !
114  IF(debug.GT.0) WRITE(lu,*) 'USER_FORCING_GAIA'
115  CALL user_forcing_gaia
116  IF(debug.GT.0) WRITE(lu,*) 'END_USER_FORCING_GAIA'
117 !
118 ! OV INSTEAD OF OS IN ORDER TO AVOID PROBLEMS WITH QUASI-BUBBLE ELEMENTS
119 ! OPERATES ONLY ON THE (1:NPOIN) RANGE OF THE TELEMAC FIELDS
120 ! IT IS A HIDDEN DISCRETISATION CHANGE
121 !
122  CALL ov('X=Y ', x=u2d%R, y=u_tel%R, dim1=npoin)
123  CALL ov('X=Y ', x=v2d%R, y=v_tel%R, dim1=npoin)
124  CALL ov('X=Y ', x=hn%R, y=h_tel%R, dim1=npoin)
125  CALL os('X=Y ', x=zf, y=zf_tel)
126 ! CLIPS NEGATIVE DEPTHS
127  IF(optban.GT.0) THEN
128 ! OPTBAN=1 : DEFAULT OPTION! TO CHANGE?
129  DO i = 1,hn%DIM1
130  IF(hn%R(i).LT.hmin) THEN
131  u2d%R(i)=0.d0
132  v2d%R(i)=0.d0
133  hn%R(i)=hmin
134  ENDIF
135  ENDDO
136  ENDIF
137 ! FREE SURFACE
138  CALL os('X=Y+Z ', x=z, y=zf, z=hn)
139 !
140 ! COPY OF TOMAWAC VARIABLES
141 !
142  IF(inclus(coupling,'TOMAWAC')) THEN
143 ! INCIDENT WAVE DIRECTION
144  CALL os( 'X=Y ',thetaw,thetaw_tel)
145 ! Wave period
146  CALL os( 'X=Y ', tw, tw_tel)
147 ! SIGNIFICANT HEIGHT
148  CALL os( 'X=Y ', hw , hw_tel)
149 ! SIGNIFICANT HEIGHT
150  CALL os( 'X=Y ', uw , uw_tel)
151  hw%TYPR='Q'
152  tw%TYPR='Q'
153  thetaw%TYPR='Q'
154  uw%TYPR='Q'
155  ENDIF
156 !
157 ! =========================================================================
158 ! TREATMENT OF TIDAL FLATS, DEFINITION OF THE MASKS
159 ! =====================================================================!
160 !
161  IF(optban.EQ.2) THEN
162 !
163 ! BUILDS MASKING BY ELEMENTS
164 !
165  CALL os ('X=Y ', x=msktmp, y=maskel)
166  CALL os ('X=C ', x=maskel, c=1.d0)
167 ! MASKS ARE DERIVED FROM THE NON-CLIPPED VALUES OF H
168 ! PROVIDED BY TELEMAC
169  CALL masktf(maskel%R,h_tel%R,hmin,mesh%IKLE%I,
170  & nelem,npoin)
171 !
172 ! JMH 17/12/2009
173 !
174 ! ELSEIF(OPTBAN.EQ.1) THEN
175 !
176 ! CANCELS Q QU AND QV IF HN.LE.0.D0
177 ! CALL MASKAB_GAIA(HN%R,Q%R,QU%R,QV%R,NPOIN)
178 !
179  ENDIF
180 !
181 ! BUILDS THE MASK OF THE POINTS FROM THE MASK OF THE ELEMENTS
182 ! AND CHANGES IFAMAS (IFABOR WITH MASKING)
183 !
184  IF(msk) CALL maskto(maskel%R,maskpt,ifamas%I,
185  & mesh%IKLE%I,
186  & mesh%IFABOR%I,mesh%ELTSEG%I,mesh%NSEG,
187  & nelem,ielmt,mesh)
188 !
189 !------------------------------------------------------------------
190 !
191 #if defined(COMPAD)
193 #endif
194 !
195 !------------------------------------------------------------------
196 !
197  IF(entet) CALL entete_gaia(2,at0,lt)
198 !
199 !---------------------------------------------------------------------
200 ! FRICTION COEFFICIENT VARIABLE IN TIME
201 !---------------------------------------------------------------------
202 !
203  CALL corstr_gaia
204 !
205 ! TREATS THE BOUNDARY CONDITIONS
206 !
207  IF(debug.GT.0) WRITE(lu,*) 'CONLIT_GAIA'
208  CALL conlit_gaia
209  IF(debug.GT.0) WRITE(lu,*) 'END CONLIT_GAIA'
210 !
211 ! =======================================================================
212 !
213 ! MEAN DIAMETER FOR THE ACTIVE-LAYER AND UNDER-LAYER
214 !
215  IF(nmud.EQ.0.AND.nsicla.GT.1.AND.nsand.GT.0) THEN
217  ENDIF
218 !
219 ! NORM OF THE MEAN VELOCITY: UNORM
220 !
221  CALL os('X=N(Y,Z)',x=unorm,y=u2d,z=v2d)
222 !
223 ! DIRECTION OF CURRENT THETAC (° and trigo )
224 ! (same convention as THETAW)
225 !
226 ! ATAN2(Y,Z)
227  CALL os('X=A(Y,Z)',x=thetac,y=v2d,z=u2d)
228 ! radians to degres
229  DO i=1,npoin
230  thetac%R(i)=thetac%R(i)*180/pi
231  thetac%R(i)=modulo(thetac%R(i),360.d0)
232  ENDDO
233 !
234 ! WAVE ORBITAL VELOCITY: UW
235 !
236  IF(houle) THEN
237 ! Forcing done inside gaia, set through the steering file
238  IF(uw%TYPR.NE.'Q') THEN
239  CALL calcuw_gaia(uw%R,hn%R,hw%R,tw%R,grav,npoin,type_houle)
240  ELSE
241 ! Monochromatic wave forcing: UW has just been calculated
242 ! in CALCUW_GAIA
243  IF(type_houle.EQ.1)THEN
244  CONTINUE
245 ! Coupling with TOMAWAC (irregular waves)
246 ! UW calculated from sprectum is an Urms!
247 ! transformation for a Jonswap spectrum (Soulsby 1993)
248  ELSEIF(type_houle.EQ.2)THEN
249  DO i=1,npoin
250  uw%R(i)=sqrt(2.d0)*uw%R(i)
251  ENDDO
252  ELSE
253  WRITE(lu,*)'VALUE OF TYPE OF WAVES IS NOT OK'
254  CALL plante(1)
255  stop
256  ENDIF
257  ENDIF
258  ENDIF
259 !
260 ! BED SHEAR STRESS COMPUTATION
261 !
262  CALL tob_gaia
264  & ks, ksp,ksr,cf, fw,uetcar, cf_tel,ks_tel, code ,
265  & icr, kspratio,houle,
266  & grav,xmve, xmvs0(1), vce, karman,zero,
268  & deltar, h_tel)
269 !
270 ! REFERENCE ELEVATION COMPUTATION
271 !
272  IF(susp) CALL zref_gaia
273 !
274 !-----------------------------------------------------------------------
275 !
276  RETURN
277  END
type(bief_obj), target uw
Orbital wave velocity.
integer iks
Bed roughness predictor option.
subroutine ov(OP, X, Y, Z, C, DIM1)
Definition: ov.f:7
logical entet
Writes out (or not)
type(bief_obj), target maskel
Mask.
type(bief_obj), target acladm
Mean diameter of active-layer.
double precision hmin
Minimal value of the water height: below this value, the sediment flow rate is set to 0...
type(bief_obj), target u2d
Components of depth-averaged velocity.
type(bief_obj), target tob
Bed shear stress [n/m2].
double precision pi
Pi.
type(bief_obj), target v2d
logical, target susp
Suspension : yes if there is at least one suspended sediment this is the case if there is mud or if s...
subroutine gaia_prepare_step(H_TEL, U_TEL, V_TEL, CF_TEL, CHARR_TEL, CODE, DELTAR, DT_TEL, HW_TEL, KS_TEL, LISTCOUNT, LOOPCOUNT, SUSP_TEL, T_TEL, THETAW_TEL, TW_TEL, UETCAR, UW_TEL, ZF_TEL)
double precision, dimension(:), pointer x
2d coordinates of the mesh
integer icr
Skin friction correction.
subroutine ad_gaia_looprecords_begin
double precision, target dt
Time step It may be different from the one in TELEMAC because of the morphological factor...
logical houle
Include wave effects.
subroutine tob_gaia(TOB, TOBW, TOBCW_MEAN, TOBCW_MAX, THETAC, THETAW, MU, KS, KSP, KSR, CF, FW, UETCAR, CF_TEL, KS_TEL, CODE, ICR, KSPRATIO, HOULE, GRAV, XMVE, XMVS, VCE, KARMAN, ZERO, HMIN, HN, ACLADM, UNORM, UW, TW, NPOIN, KSCALC, IKS, DELTAR, H_TEL)
Definition: tob_gaia.f:11
double precision mofac
Morphological factor on the hydrodynamics: distorts the evolution of the hydrodynamics with respect t...
subroutine maskto(MASKEL, MASKPT, IFAMAS, IKLE, IFABOR, ELTSEG, NSEG, NELEM, IELM, MESH)
Definition: maskto.f:8
double precision xmve
Water density (from steering file of T2D or T3D)
integer optban
Option for the treatment of tidal flats.
type(bief_obj), target tobcw_max
Maximum of total current + wave shear stress.
type(bief_obj), target ks
Total bed roughness.
double precision, dimension(:), pointer y
double precision vce
Water viscosity: it is defined here because the viscosity set in TELEMAC2D or TELEMAC3D may not b the...
type(bief_obj), target thetaw
Wave direction (deg wrt ox axis) !!!!!some say oy axis!!!!!
type(bief_obj), target thetac
Current direction (deg trigo)
subroutine mean_grain_size_gaia
type(bief_obj), target fw
Quadratic friction coefficient (waves)
subroutine conlit_gaia
Definition: conlit_gaia.f:4
double precision, dimension(nsiclm) xmvs0
Sand density.
subroutine masktf(MASKEL, HN, HMIN, IKLE, NELEM, NPOIN)
Definition: masktf.f:7
integer nsand
Total number of sand.
double precision zero
Parameter used for clipping variables or testing values against zero.
integer type_houle
Type of waves (regular or irregular)
type(bief_obj), target hw
Significant wave height.
integer, pointer nelem
Number of elements in the mesh.
subroutine entete_gaia(IETAPE, AT, LT)
Definition: entete_gaia.f:7
type(bief_obj), target hn
Water depth.
type(bief_obj), target unorm
Norm of the mean flow velocity.
subroutine ad_gaia_timestep_begin
logical function inclus(C1, C2)
Definition: inclus.f:7
integer, target nsicla
Number of sediment classes of bed material (less than NISCLM)
double precision grav
Gravity acceleration.
type(bief_obj), target z
Free surface elevation.
logical msk
Include masking.
type(bief_obj), target msktmp
Mask.
integer nmud
Total number of muds.
type(bief_obj), target mu
Skin friction correction factor for bed roughness: Ratio between shear stress due skin friction and t...
subroutine user_forcing_gaia
subroutine corstr_gaia
Definition: corstr_gaia.f:4
integer, target lt
Numero du pas de temps.
subroutine ad_gaia_subiteration_begin
type(bief_obj), target ifamas
Like IFABOR but ignoring masked elements.
type(bief_obj), target tw
Mean wave period.
integer debug
Debugger.
double precision, target kspratio
Ratio between skin friction and mean diameter.
type(bief_obj), target cf
Quadratic friction coefficient.
subroutine os(OP, X, Y, Z, C, IOPT, INFINI, ZERO)
Definition: os.f:7
type(bief_obj), target zf
Bottom elevation.
type(bief_obj), target tobw
Wave induced shear stress.
type(bief_mesh), target mesh
Mesh structure.
integer ielmt
Missing comment.
logical, target charr
Include bedload in the simulation.
double precision at0
logical kscalc
Bed roughness prediction.
subroutine calcuw_gaia(UW, H, HW, TW, GRAV, NPOIN, TYPE_HOULE)
Definition: calcuw_gaia.f:7
type(bief_obj), target tobcw_mean
Mean of total current + wave shear stress.
double precision karman
Karman constant.
type(bief_obj), target ksr
Ripple bed roughness.
type(bief_obj), target ksp
Bed skin roughness.
subroutine zref_gaia
Definition: zref_gaia.f:4
character(len=path_len), target coupling
integer, pointer npoin
Number of 2d points in the mesh.
Definition: bief.f:3
type(bief_obj), target maskpt
Mask on points.