-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathMOD_Hydrodynamic.f90
385 lines (343 loc) · 22.5 KB
/
MOD_Hydrodynamic.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
!>@brief Variable declation for hydrodynamic computation
!>@author Rafael Cavalcanti
!>@attention List of modification
!>@parblock
!! -> 10.03.2014: Routine Implementation (Rafael Cavalcanti)
!!
!! -> 15.09.2015: Routine Update (Carlos Ruberto Fragoso)
!>@endparblock
Module Hydrodynamic
use domain_types
Implicit None
type HydrodynamicParam
Real:: Pi = 3.141592653589793238462d0 !< Pi number
Real:: SmallNumber = 1e-5 !< Small Number
! 2. Vertical Discretization Variables
!Real:: zL !< lowest reference elevation (needs to be lower than the max elevation found in geometry mesh)
!Real:: zR !< greatest reference elevation (needs to be greater than the max elevation found in geometry mesh)
Real, Allocatable:: Z(:,:) !< Elevation in the bottom of the layer in each edge
Real, Allocatable:: Ze(:,:) !< Elevation in the bottom of the layer in each element
Real, Allocatable:: Zb(:,:) !< Elevation in the center of the layer in each element
Real, Allocatable:: DZj(:,:) !< Height of the layer in each edge in the time n+1
Real, Allocatable:: DZjt(:,:) !< Height of the layer in each edge in the time n
Real, Allocatable:: DZi(:,:) !< Height of the layer in each element in the time n+1
Real, Allocatable:: DZit(:,:) !< Height of the layer in each element in the time n
Real, Allocatable:: iADZ(:,:)
Real, Allocatable:: iAG(:,:)
Real, Allocatable:: DZiADZ(:)
Real, Allocatable:: DZiAG(:)
Integer, Allocatable:: Smallm(:) !<Lower layer index at the edge of the element
Integer, Allocatable:: Smallms(:) !<Lower layer index at the edge of the element
Integer, Allocatable :: CapitalM(:) !<greatest layer index at the edge of the element
Integer, Allocatable :: CapitalMs(:) !<greatest layer index at the edge of the element !CAYO
Integer, Allocatable :: ElSmallm(:) !<Lower layer index at the center of the element
Integer, Allocatable :: ElSmallms(:) !<Lower layer index at the center of the element
Integer, Allocatable :: ElCapitalM(:) !<greatest layer index at the center of the element
Integer, Allocatable :: ElCapitalMs(:) !<greatest layer index at the center of the element !CAYO
Real, Allocatable:: DZK(:) !Sediment Layer
Real, Allocatable:: PsiCrit(:) !Sediment Layer
Real, Allocatable:: Gusub(:,:) !Sediment Layer
Real, Allocatable:: psij(:,:)!CAYO
Real, Allocatable:: rj(:,:)!CAYO
Real, Allocatable:: DZsj(:,:)!CAYO
Real, Allocatable:: DZsjt(:,:)!CAYO
Real, Allocatable:: DZhj(:,:)!CAYO
Real, Allocatable:: DZhjt(:,:) !CAYO
Real, Allocatable:: DZsi(:,:)!CAYO
Real, Allocatable:: DZsit(:,:)!CAYO
Real, Allocatable:: DZhi(:,:)!CAYO
Real, Allocatable:: DZhit(:,:) !CAYO
! 3. Hydrodynamic
Real:: SumVerAcum =0
Real:: SumVer
! 3.1. Velocities
Real, Allocatable:: u(:,:) !< Normal velocity at the edges in each layer, dimension: Kmax,nEdge
Real, Allocatable:: ut(:,:) !< Normal velocity at previous time step, dimension: Kmax,nEdge
Real, Allocatable:: utang(:,:) !< Normal velocity at the edges in each layer, dimension: Kmax,nEdge
Real, Allocatable:: uxyback(:,:,:) !< horizontal backtracking velocity components at the edges in each layer, dimension: Kmax,2,nEdge
Real, Allocatable:: uArrow(:,:,:)
Real, Allocatable:: uNode(:,:,:) !< Nodal velocity , dimension: Kmax,2,nNode
Real, Allocatable:: uxy(:,:,:) !< horizontal velocity components at current time step ,dimension: (Kmax,2,nEdge)
Real, Allocatable:: uxyL(:,:,:) !< horizontal velocity components in the center of each k+1/2 Layer for eack Element ,dimension: (Kmax+1,2,nElem)
Real, Allocatable:: Wu(:,:) !< horizontal velocity components at current time step ,dimension: (Kmax,nEdge)
Real, Allocatable:: ug(:,:),vg(:,:),wg(:,:) !< Velocities in each face in k+1/2 Layer dimension: (nEdge,Kmax+1)
Real, Allocatable:: ub(:,:,:) !< cell-centered three components of velocity, dimension: ub(Kmax,3,nElem)
Real, Allocatable:: ubV(:,:,:) !< Vertice center three components of velocity, dimension: ubV(Kmax,3,nNode)
Real, Allocatable:: ubBack(:,:,:) !< backtracking velocity components at the center of each Element in each layer, dimension: Kmax,2,nElem
Real, Allocatable:: w(:,:) !< vertical velocity dimension: (Kmax+1,nElem)
Real, Allocatable:: wt(:,:) !< vertical velocity dimension at previous time step: (Kmax+1,nElem)
Real, Allocatable:: wfc(:,:) !< Face-centered vertical velocity dimension: (Kmax,nEdge)
Real, Allocatable:: FuxyNode(:,:,:)
Real, Allocatable:: Fub(:,:,:)
Real, Allocatable:: Fw(:,:) !< vertical velocity dimension at previous time step: (Kmax+1,nElem)
Real, Allocatable:: epson(:,:) !< Normal velocity at the edges in each layer, dimension: Kmax,nEdge
Real, Allocatable:: psi_edge(:,:)
Real, Allocatable:: psi_cell(:,:)
Real, Allocatable:: uNodet(:,:,:) !< Nodal velocity , dimension: Kmax,2,nNode
Real, Allocatable:: uxyt(:,:,:) !< horizontal velocity components at current time step ,dimension: (Kmax,2,nEdge)
Real, Allocatable:: uxyLt(:,:,:)
Real, Allocatable:: ugt(:,:),vgt(:,:),wgt(:,:) !< Velocities in each face in k+1/2 Layer dimension: (nEdge,Kmax+1)
Real, Allocatable:: ubt(:,:,:) !< cell-centered three components of velocity, dimension: ub(Kmax,3,nElem)
Real, Allocatable:: ubVt(:,:,:)
Real, Allocatable:: wfct(:,:)
Integer, Allocatable:: utangNodes(:,:)
Real, Allocatable:: uxysub(:,:,:)
Real, Allocatable:: ubsub(:,:,:)
Real, Allocatable:: us(:,:) !< Normal superficial flow velocity at the edges in each layer, dimension: Kmax,nEdge !CAYO
Real, Allocatable:: ust(:,:) !< Normal superficial flow velocity at previous time step, dimension: Kmax,nEdge !CAYO
Real, Allocatable:: ustang(:,:) !< Normal superficial flow velocity at previous time step, dimension: Kmax,nEdge !CAYO
Real, Allocatable:: um(:,:) !< Kmax,nEdge !CAYO
Real, Allocatable:: umt(:,:) !< Kmax,nEdge !CAYO
Real, Allocatable:: umtang(:,:) !< Kmax,nEdge !CAYO
Real, Allocatable:: wm(:,:)
Real, Allocatable:: wmt(:,:)
! 3.1. Others Variables
Real, Allocatable:: etaInf(:) !< Tidal boundary condition
Real, Allocatable:: etaInfn(:) !< Tidal boundary condition in time n-1
Real, Allocatable:: etaplus(:) !< Vertical water balance at current time step dimension: nElem
Real, Allocatable:: peta(:) !< Nodal free-Surface Elevation at current time step dimension: nNode
Real, Allocatable:: petan(:) ! Nodal Free-Surface Elevation from previous timestep n (Time Step N+1; Time Step N) dimension: nElem
Real, Allocatable:: eta(:) !< Cell-centered Free-Surface Elevation at current time step dimension: nElem
Real, Allocatable:: etak(:) !< Cell-centered Free-Surface Elevation at current time step dimension: nElem
Real, Allocatable:: etan(:) ! Cell-centered Free-Surface Elevation from previous timestep n (Time Step N+1; Time Step N) dimension: nElem
Real, Allocatable:: hb(:) !< elevation at the center of each element dimension: nElem
Real, Allocatable:: sb(:)
Real, Allocatable:: H(:) !< depth of the Edge dimension: nEdge
Real, Allocatable:: hj(:) !< elevation of the edge dimension: nEdge
Real, Allocatable:: sj(:) !< elevation of the edge dimension: nEdge
Real, Allocatable:: Hu(:) !< vertically integrated velocity, dimension: nEdge
Real, Allocatable:: P(:) !< area (term P in casulli 2000), dimension: nElem
Real, Allocatable:: Aeta(:) !< Volume in the element
Real, Allocatable:: f(:) !< vector P in casulli 2000
Real, Allocatable:: Deta(:), rhs(:), Gu(:,:), Fu(:,:), Fv(:,:), Fvu(:,:), Fuv(:,:)
Real, Allocatable:: rhsnonHydro(:,:)
Real, Allocatable:: q(:,:),pq(:,:)
Real, Allocatable:: Rug(:) !< Roughness coefficient
Real, Allocatable:: GammaB(:) ! Bed Friction Coefficient
Real, Allocatable:: uIniVec(:,:) !< Initial condition of velocity components
Real, Allocatable:: sDRhoW(:,:) !<Water density
Real, Allocatable:: sDRhoWt(:,:) !<Water density
Real, Allocatable:: Hs(:) !CAYO
!Real, Allocatable:: Kj(:,:), ei(:,:) !Porosity and Hydraulic Conductivity !CAYO !MOD_Mesh
Real, Allocatable:: Vol(:) !<Water Volume in element with porous region !CAYO
Real, Allocatable:: Vol2(:) !<Water Volume in element with porous region !CAYO
Real, Allocatable:: Vol1(:) !<Water Volume in element with porous region !CAYO
Real, Allocatable:: Qk(:)
Real, Allocatable:: Ci(:)
Real, Allocatable:: etam(:)
Real, Allocatable:: d(:)
! 4. Turbulence Model
Real,Allocatable:: HorViscosity(:,:,:) !< Horizontal Eddy Viscosity
Real,Allocatable:: HorDiffusivity(:,:,:) !< Horizontal Eddy Diffusivity
Real,Allocatable:: VerEddyVisc(:,:) !< Vertical Eddy Viscosity Edge
Real,Allocatable:: VerEddyDiff(:,:) !< Vertical Eddy Diffusivity Edge
Real,Allocatable:: VerEddyViscCell(:,:) !< Vertical Eddy Viscosity Cell-centered
Real,Allocatable:: VerEddyDiffCell(:,:) !< Vertical Eddy Diffusivity Cell-centered
Real, Allocatable:: TKE(:,:), TKEP(:,:) ! Total Kinetic Energy
Real, Allocatable:: LengthScale(:,:), LengthScaleP(:,:) ! Turbulent Eddy Length Scale
Real, Allocatable:: DissipRate(:,:) ! Dissipation Rate of Total Kinetic Energy
Real, Allocatable:: ShearProd(:,:), BuoyancyProd(:,:) ! Dissipation Rate of Total Kinetic Energy
! 5. Pressure
Real,Allocatable:: PBarc(:,:) !< baroclinic pressure contribution
! 6. Boundary Conditions
Real, Allocatable:: WindVel(:,:)
Real, Allocatable:: WindXY(:,:)
Real, Allocatable:: Windix(:),Windiy(:)
Real, Allocatable:: InFlowValue(:,:),WaterLevelValue(:,:)
Real, Allocatable:: InFlowTime(:,:),WaterLevelTime(:,:)
Integer, Allocatable:: InFlownTime(:),WaterLevelnTime(:)
Integer, Allocatable:: InFlowSmallm(:),InFlowCapitalM(:)
Integer, Allocatable:: IndexWaterLevel(:,:)
Integer, Allocatable:: IndexWaterLevelEdge(:)
Integer, Allocatable:: IndexInflow(:,:)
Integer, Allocatable:: IndexInflowEdge(:)
Real, Allocatable:: WaterLevel(:)
Integer:: NInflow, NWaterLevel
Integer, Allocatable:: NRange(:)
Real, Allocatable:: irrgMirim(:), irrgMangueira(:) !Bench Lagoas
! 7. Hydrodynamic Parameters
Integer:: NFUT !<Numbers of Sub-time steps for ELM (used in FUFV)
Integer:: NTRASP !<Maximum Numbers of Sub-time steps for transport solution (used in FUFV)
Real:: Lat !<average latitude
Real:: Altit !<average altitude
Real:: ALB !<Albedo
Real:: OMEGA !<Earth angular velocity (in rad/sec)
Real:: g !<Acceleration due to gravity (m/s²)
Real, Allocatable:: CFL(:) !<CourantFriedrichLewy Number
Real:: nux, nuy, nuz
!Real:: GammaB !<Tension in the bottom layer
Real:: GammaT !<Tension in the surface layer
Real:: Theta !<Implicitness coefficient (from 0.5 to 1.00)
Real:: CSmag !<Smagorinsky coefficient (from 0.10 to 0.20)
Real:: HorEddyDiffY_Back !<Background horizontal Diffusivity
Real:: HorEddyViscX_Cte !<Horizontal Viscosity (x-direction)
Real:: HorEddyViscY_Cte !<Horizontal Viscosity (y-direction)
Real:: VerEddyVisc_Cte !<Vertical Viscosity (constant)
Real:: HorEddyDiffX_Cte !<Horizontal Diffusivity (x-direction)
Real:: HorEddyDiffY_Cte !<Horizontal Diffusivity (y-direction)
Real:: VerEddyDiff_Cte !< Vertical Diffusivity (constant)
Real:: alfa_turbmodel1, n_turbmodel1 !<Vertical mixing turbulence model (VerTurbFlag == 1)
Real:: vref !<Vertical eddy Viscosity of Reference (VerTurbFlag == 1)
Real:: vmin !<Background Vertical eddy Viscosity (VerTurbFlag == 1)
Real:: tdmin_pp !<Background Vertical eddy diffuvsivity (VerTurbFlag == 1)
Real:: rho0 !<Water density of reference (kg/m³)
Real:: WtempRef !<Water temperature of reference (oC)
Real:: AirtempRef !<Air temperature of reference (oC)
Real:: Pcri !<threshold Depth for dry/wet algorithm
Real:: smoothingTime !<Smoothing period to eliminate effects of the initial conditions
Real:: windDragConstant !<wind Drag coefficient (constant)
Real:: windDragCoefficient(3) !<wind Drag coefficient (linear function)
Real:: windDragWindSpeed(3) !<Wind Speed threshold for changing wind Drag coefficient (linear function)
Real:: RugChezyConst !<Roughness coeficient of Chezy (Constant)
Real:: RugManConst !<Roughness coeficient of Manning (Constant)
Real:: RugWCConst !<Roughness coeficient of White-Colebrook (Constant)
!Real, Allocatable:: rhoair(:) !<Air density (kg/m³)
!Fetch
Real, Allocatable:: fetch_m(:,:) !<Fetch distance (m)
!8. Initial Condition
Real:: Uini !<Initial condition of x velocity component (m/s)
Real:: Vini !<Initial condition of y velocity component (m/s)
Real:: Wini !<Initial condition of z velocity component (m/s)
Real:: Zini !<Initial condition of elevation surface water (m)
! 9. Flags
Integer:: OutPutFlag !< Output flag: OutPutFlag = 0 (to be defined); OutPutFlag = 1 (VKT output)
!Integer:: ConvectiveFlag (iConv)
!Integer:: HorTurbFlag (iHTurb)
!Integer:: VerTurbFlag (iVTurb)
!Integer:: SurfTensionFlag
Integer:: BottomTensionFlag
!Integer:: ResuspMethodFlag (vai para modulo de limnologia)
!Integer:: SetMethodFlag (vai para modulo de limnologia)
Integer:: iWindStress ! (SurfTensionFlag)< Wind Stress on Water Surface formulation: iWindStress = 0 (Based on Wind Drag coefficient); iWindStress = 1 (Based on Air density)
Integer:: iWindDrag !< Wind Drag coefficient formulation: iWindDrag = 0 (Constant); iWindDrag = 1 (Linear function)
Integer:: iRoughForm !< Roughness Formulation: iRoughForm = 0 (roughnessChezyConstant); iRoughForm = 1 (roughnessManningConstant); iRoughForm = 2 (roughnessWhiteColebrookConstant); iRoughForm = 3 (roughnessChezyUseGridData); iRoughForm = 4 (roughnessManningUseGridData); iRoughForm = 5 (roughnessWhiteColebrookUseGridData);
Integer:: iHTurb !< Horizontal turbulence Formulation: iHTurb = 0 (constant); iHTurb = 1 (Smagorinsky model)
Integer:: iVTurb !< Vertical turbulence Formulation: iVTurb = 0 (constant); iVTurb = 1 (zero model)
Integer:: iBTurb !< Bottom turbulence Formulation (not implemented yet)
Integer:: iConv !< Formulation for convective terms: iConv = 0 (Neglect Nonlinear Convection); iConv = 1 (Eulerian-Lagragean Method)
Integer:: iBarot !< Barotropic effect: iBarot = 0 (no); iBarot = 1 (yes)
Integer:: iNonHydro !< Non hydrostatic pressure effect: iNonHydro = 0 (no); iNonHydro = 1 (yes)
Integer:: iCoriolis !< Coriolis effect: iCoriolis = 0 (no); iCoriolis = 1 (yes)
Real, Allocatable:: SScalar(:) ! Salinity Concentration - Current Time Step
Real, Allocatable:: SScalarSaturation(:) ! Salinity Concentration - Current Time Step
Real, Allocatable:: SScalar2D(:) ! Salinity Concentration - Current Time Step
Real, Allocatable:: SVector(:,:) ! Salinity Concentration - Current Time Step
! Transport Equation Variables
Real, Allocatable:: uLoadVarEst(:,:)
Real, Allocatable:: dVarEst(:,:,:)
Real, Allocatable:: Locdt(:,:)
Real, Allocatable:: DZitau(:,:)
Real, Allocatable:: DZistau(:,:)
contains
procedure :: initializeHydroParam
end type
contains
subroutine initializeHydroParam(this, hydroConfiguration)
Integer:: i,j
Real:: LATR
!character, pointer :: hydroParametersName(:)
type(HydrodynamicConfiguration) :: hydroConfiguration
type(HydrodynamicParameter), pointer :: hydroParameters(:)
character(len=200):: text
class(HydrodynamicParam) :: this
call c_f_pointer(hydroConfiguration%parameters, hydroParameters, [hydroConfiguration%numberOfParameters])
Do i = 1, hydroConfiguration%numberOfParameters
text = trim(hydroParameters(i)%name)
!Flags
If (trim(text) == 'iWindStress') Then
this%iWindStress = hydroParameters(i)%value
ElseIf (trim(text) == 'iWindDrag') Then
this%iWindDrag = hydroParameters(i)%value
ElseIf (trim(text) == 'bottomRoughness') Then
this%iRoughForm = hydroParameters(i)%value
ElseIf (trim(text) == 'horizontalEddyVD') Then
this%iHTurb = hydroParameters(i)%value
ElseIf (trim(text) == 'verticalEddyVD') Then
this%iVTurb = hydroParameters(i)%value
ElseIf (trim(text) == 'iBTurb') Then
this%iBTurb = hydroParameters(i)%value
ElseIf (trim(text) == 'iConv') Then
this%iConv = hydroParameters(i)%value
ElseIf (trim(text) == 'pressure') Then
this%iBarot = hydroParameters(i)%value
ElseIf (trim(text) == 'hydrostaticComponent') Then
this%iNonHydro = hydroParameters(i)%value
ElseIf (trim(text) == 'iCoriolis') Then
this%iCoriolis = hydroParameters(i)%value
EndIf
!Parameters
If (trim(text) == 'waterDensity') Then
this%rho0 = hydroParameters(i)%value
ElseIf (trim(text) == 'waterTemperature') Then
this%WtempRef = hydroParameters(i)%value
ElseIf (trim(text) == 'airTemperature') Then
this%AirtempRef = hydroParameters(i)%value
ElseIf (trim(text) == 'thetaCoefficient') Then
this%theta = hydroParameters(i)%value
ElseIf (trim(text) == 'thresholdDepth') Then
this%Pcri = hydroParameters(i)%value
ElseIf (trim(text) == 'smoothingTime') Then
this%smoothingTime = hydroParameters(i)%value
ElseIf (trim(text) == 'windDragConstant') Then
this%windDragConstant = hydroParameters(i)%value
ElseIf (trim(text) == 'windDragCoefficientC1') Then
this%windDragCoefficient(1) = hydroParameters(i)%value
ElseIf (trim(text) == 'windDragCoefficientC2') Then
this%windDragCoefficient(2) = hydroParameters(i)%value
ElseIf (trim(text) == 'windDragCoefficientC3') Then
this%windDragCoefficient(3) = hydroParameters(i)%value
ElseIf (trim(text) == 'windDragWindSpeedW1') Then
this%windDragWindSpeed(1) = hydroParameters(i)%value
ElseIf (trim(text) == 'windDragWindSpeedW2') Then
this%windDragWindSpeed(2) = hydroParameters(i)%value
ElseIf (trim(text) == 'windDragWindSpeedW3') Then
this%windDragWindSpeed(3) = hydroParameters(i)%value
ElseIf (trim(text) == 'roughnessChezyConstant') Then
this%RugChezyConst = hydroParameters(i)%value
ElseIf (trim(text) == 'roughnessManningConstant') Then
this%RugManConst = hydroParameters(i)%value
ElseIf (trim(text) == 'roughnessWhiteColebrookConstant') Then
this%RugWCConst = hydroParameters(i)%value
ElseIf (trim(text) == 'horizontalEddyViscosity') Then
this%HorEddyViscX_Cte = hydroParameters(i)%value
this%HorEddyViscY_Cte = this%HorEddyViscX_Cte
ElseIf (trim(text) == 'horizontalEddyDiffusivity') Then
this%HorEddyDiffX_Cte = hydroParameters(i)%value
this%HorEddyDiffY_Cte = this%HorEddyDiffX_Cte
ElseIf (trim(text) == 'smagorinskyCoefficient') Then
this%CSmag = hydroParameters(i)%value
ElseIf (trim(text) == 'backgroundHorizontalEddyDiffusivity') Then
this%HorEddyDiffY_Back = hydroParameters(i)%value
ElseIf (trim(text) == 'verticalEddyViscosity') Then
this%VerEddyVisc_Cte = hydroParameters(i)%value
ElseIf (trim(text) == 'verticalEddyDiffusivity') Then
this%VerEddyDiff_Cte = hydroParameters(i)%value
ElseIf (trim(text) == 'refVerticalEddyViscosity') Then
this%vref = hydroParameters(i)%value
ElseIf (trim(text) == 'backgroundVerticalEddyViscosity') Then
this%vmin = hydroParameters(i)%value
ElseIf (trim(text) == 'backgroundVerticalEddyDiffusivity') Then
this%tdmin_pp = hydroParameters(i)%value
ElseIf (trim(text) == 'numberOfSubTimeSteps') Then
this%NFUT = hydroParameters(i)%value
ElseIf (trim(text) == 'earthsRotationSpeed') Then
this%OMEGA = hydroParameters(i)%value
ElseIf (trim(text) == 'latitude') Then
this%Lat = hydroParameters(i)%value
ElseIf (trim(text) == 'atitude') Then
this%Altit = hydroParameters(i)%value
EndIf
!print *, hydroParametersName, hydroParameters(i)%value
EndDo
this%alfa_turbmodel1 = 5.d0
this%n_turbmodel1 = 1.d0
this%NTRASP = 10.d0
!Gravity of the Earth (m/s²)
this%g = 9.810665d0 !9.780327*(1. + 0.0053024*(sin(this%Lat*this%Pi/180))**2. - 0.0000058*sin(2*this%Lat*this%Pi/180)**2. ) - 3.086e-6*this%Altit
!Reference water density (kg/m³)
this%rho0 = 1000.d0
!Albedo
LATR = 180.d0*(ASIN(SIN(ABS(this%LAT)/1.33d0*this%PI/180.d0)))/this%PI
this%ALB = (((COS(ABS(this%LAT)*this%PI/180.d0)-COS(LATR*this%PI/180.d0)*1.33d0)/(COS(ABS(this%LAT)*this%PI/180.d0)+COS(LATR*this%PI/180.d0)*1.33d0))**2.+((COS(LATR*this%PI/180.d0)-COS(ABS(this%LAT)*this%PI/180.d0)*1.33d0)/(COS(LATR*this%PI/180.d0)+COS(ABS(this%LAT)*this%PI/180.d0)*1.33d0))**2.d0)/2.d0
end subroutine
End Module Hydrodynamic