MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_variables_conversion.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2!>
3!! @file
4!! @brief Contains module m_variables_conversion
5
6# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
7# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
8# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
9# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
10# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
11# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
12# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
13# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
14
15# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
16# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
17# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
18
19# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
20
21# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
22
23# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24
25# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26
27# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
28
29# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30
31# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
32! New line at end of file is required for FYPP
33# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
34# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
35# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
36# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
38# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
44# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45
46# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49
50# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59! New line at end of file is required for FYPP
60# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
61
62# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
63# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
64# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
65# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
66# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
67
68# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
69
70# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
71
72# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
73
74# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75
76# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77
78# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 207 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 232 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 243 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 245 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 283 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 293 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 303 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 312 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 329 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 346 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 358 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 364 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 370 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 376 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138! New line at end of file is required for FYPP
139# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
140# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
141# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
142# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
143# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
144# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
145# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
146# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
147
148# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
149# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
150# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
151
152# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
153
154# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155
156# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157
158# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159
160# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161
162# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165! New line at end of file is required for FYPP
166# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
167
168# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
169
170# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
171
172# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
173
174# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
175
176# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
177
178# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
179
180# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
181
182# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 192 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 213 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 241 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 256 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 266 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 275 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 291 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 301 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 308 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223! New line at end of file is required for FYPP
224# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
225
226# 21 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
227
228# 37 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
229
230# 50 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
231
232# 104 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
233
234# 119 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
235
236# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
237
238# 143 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
239
240# 171 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
241
242# 182 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
243
244# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
245
246# 204 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
247
248# 214 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250# 225 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
251
252# 236 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
253
254# 246 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256# 252 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
257
258# 258 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
259
260# 264 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262# 270 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
263
264# 272 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
265# 273 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
266! New line at end of file is required for FYPP
267# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
268
269# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
270
271! Caution:
272! This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI rank.
273! That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0.
274! For an example see misc/nvidia_uvm/bind.sh.
275# 63 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
276
277# 81 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
278
279# 88 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
280
281# 111 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
282
283# 127 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
284
285# 153 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
286
287# 159 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
288
289# 167 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
290! New line at end of file is required for FYPP
291# 6 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp" 2
292# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
293! This file exists so that Fypp can be run without generating case.fpp files for
294! each target. This is useful when generating documentation, for example. This
295! should also let MFC be built with CMake directly, without invoking mfc.sh.
296
297! For pre-process.
298# 9 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
299
300! For moving immersed boundaries in simulation
301# 14 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
302# 7 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp" 2
303
304!> @brief Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation
305module m_variables_conversion
306
307 use m_derived_types !< definitions of the derived types
308
309 use m_global_parameters !< definitions of the global parameters
310
311 use m_mpi_proxy !< message passing interface (mpi) module proxy
312
313 use m_helper_basic !< functions to compare floating point numbers
314
315 use m_helper
316
317 use m_thermochem, only: &
318 num_species, get_temperature, get_pressure, gas_constant, &
319 get_mixture_molecular_weight, get_mixture_energy_mass
320
321 implicit none
322
323 private;
324 public :: s_initialize_variables_conversion_module, &
325 s_initialize_pb, &
326 s_initialize_mv, &
327 s_convert_to_mixture_variables, &
328 s_convert_mixture_to_mixture_variables, &
329 s_convert_species_to_mixture_variables, &
330 s_convert_species_to_mixture_variables_acc, &
331 s_convert_conservative_to_primitive_variables, &
332 s_convert_primitive_to_conservative_variables, &
333 s_convert_primitive_to_flux_variables, &
334 s_compute_pressure, &
335 s_compute_species_fraction, &
336#ifndef MFC_PRE_PROCESS
337 s_compute_speed_of_sound, &
338 s_compute_fast_magnetosonic_speed, &
339#endif
340 s_finalize_variables_conversion_module
341
342 !! In simulation, gammas, pi_infs, and qvs are already declared in m_global_variables
343#ifndef MFC_SIMULATION
344 real(wp), allocatable, public, dimension(:) :: gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps
345
346# 49 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
347#if defined(MFC_OpenACC)
348# 49 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
349!$acc declare create(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps)
350# 49 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
351#elif defined(MFC_OpenMP)
352# 49 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
353!$omp declare target (gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps)
354# 49 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
355#endif
356#endif
357
358 real(wp), allocatable, dimension(:) :: gs_vc
359 integer, allocatable, dimension(:) :: bubrs_vc
360 real(wp), allocatable, dimension(:, :) :: res_vc
361
362# 55 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
363#if defined(MFC_OpenACC)
364# 55 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
365!$acc declare create(bubrs_vc, Gs_vc, Res_vc)
366# 55 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
367#elif defined(MFC_OpenMP)
368# 55 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
369!$omp declare target (bubrs_vc, Gs_vc, Res_vc)
370# 55 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
371#endif
372
373 integer :: is1b, is2b, is3b, is1e, is2e, is3e
374
375# 58 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
376#if defined(MFC_OpenACC)
377# 58 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
378!$acc declare create(is1b, is2b, is3b, is1e, is2e, is3e)
379# 58 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
380#elif defined(MFC_OpenMP)
381# 58 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
382!$omp declare target (is1b, is2b, is3b, is1e, is2e, is3e)
383# 58 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
384#endif
385
386 real(wp), allocatable, dimension(:, :, :), public :: rho_sf !< Scalar density function
387 real(wp), allocatable, dimension(:, :, :), public :: gamma_sf !< Scalar sp. heat ratio function
388 real(wp), allocatable, dimension(:, :, :), public :: pi_inf_sf !< Scalar liquid stiffness function
389 real(wp), allocatable, dimension(:, :, :), public :: qv_sf !< Scalar liquid energy reference function
390
391contains
392
393 !> Dispatch to the s_convert_mixture_to_mixture_variables
394 !! and s_convert_species_to_mixture_variables subroutines.
395 !! Replaces a procedure pointer.
396 !! @param q_vf Conservative or primitive variables
397 !! @param i First-coordinate cell index
398 !! @param j Second-coordinate cell index
399 !! @param k Third-coordinate cell index
400 !! @param rho Density
401 !! @param gamma Specific heat ratio function
402 !! @param pi_inf Liquid stiffness function
403 !! @param qv Fluid reference energy
404 !! @param Re_K Reynolds number (optional)
405 !! @param G_K Shear modulus (optional)
406 !! @param G Shear moduli of the fluids (optional)
407 subroutine s_convert_to_mixture_variables(q_vf, i, j, k, &
408 rho, gamma, pi_inf, qv, Re_K, G_K, G)
409
410 type(scalar_field), dimension(sys_size), intent(in) :: q_vf
411 integer, intent(in) :: i, j, k
412 real(wp), intent(out), target :: rho, gamma, pi_inf, qv
413 real(wp), optional, dimension(2), intent(out) :: re_k
414 real(wp), optional, intent(out) :: g_k
415 real(wp), optional, dimension(num_fluids), intent(in) :: g
416
417 if (model_eqns == 1) then ! Gamma/pi_inf model
418 call s_convert_mixture_to_mixture_variables(q_vf, i, j, k, &
419 rho, gamma, pi_inf, qv)
420
421 else ! Volume fraction model
422 call s_convert_species_to_mixture_variables(q_vf, i, j, k, &
423 rho, gamma, pi_inf, qv, re_k, g_k, g)
424 end if
425
426 end subroutine s_convert_to_mixture_variables
427
428 !> This procedure conditionally calculates the appropriate pressure
429 !! @param energy Energy
430 !! @param alf Void Fraction
431 !! @param dyn_p Dynamic Pressure
432 !! @param pi_inf Liquid Stiffness
433 !! @param gamma Specific Heat Ratio
434 !! @param rho Density
435 !! @param qv fluid reference energy
436 !! @param rhoYks Species partial densities
437 !! @param pres Pressure to calculate
438 !! @param T Temperature
439 !! @param stress Shear Stress
440 !! @param mom Momentum
441 !! @param G Shear modulus (optional)
442 !! @param pres_mag Magnetic pressure (optional)
443 subroutine s_compute_pressure(energy, alf, dyn_p, pi_inf, gamma, rho, qv, rhoYks, pres, T, stress, mom, G, pres_mag)
444
445# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
446#ifdef _CRAYFTN
447# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
448#if MFC_OpenACC
449# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
450!$acc routine seq
451# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
452#elif MFC_OpenMP
453# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
454
455# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
456
457# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
458!$omp declare target device_type(any)
459# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
460#else
461# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
462!DIR$ NOINLINE s_compute_pressure
463# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
464#endif
465# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
466#elif MFC_OpenACC
467# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
468!$acc routine seq
469# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
470#elif MFC_OpenMP
471# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
472
473# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
474
475# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
476!$omp declare target device_type(any)
477# 118 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
478#endif
479# 120 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
480
481 real(stp), intent(in) :: energy, alf
482 real(wp), intent(in) :: dyn_p
483 real(wp), intent(in) :: pi_inf, gamma, rho, qv
484 real(wp), intent(out) :: pres
485 real(wp), intent(inout) :: t
486 real(stp), intent(in), optional :: stress, mom
487 real(wp), intent(in), optional :: g, pres_mag
488
489 ! Chemistry
490 real(wp), dimension(1:num_species), intent(in) :: rhoyks
491 real(wp), dimension(1:num_species) :: y_rs
492 real(wp) :: e_e
493 real(wp) :: e_per_kg, pdyn_per_kg
494 real(wp) :: t_guess
495
496 integer :: s !< Generic loop iterator
497
498# 139 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
499 ! Depending on model_eqns and bubbles_euler, the appropriate procedure
500 ! for computing pressure is targeted by the procedure pointer
501
502 if (mhd) then
503 pres = (energy - dyn_p - pi_inf - qv - pres_mag)/gamma
504 elseif ((model_eqns /= 4) .and. (bubbles_euler .neqv. .true.)) then
505 pres = (energy - dyn_p - pi_inf - qv)/gamma
506 else if ((model_eqns /= 4) .and. bubbles_euler) then
507 pres = ((energy - dyn_p)/(1._wp - alf) - pi_inf - qv)/gamma
508 else
509 pres = (pref + pi_inf)* &
510 (energy/ &
511 (rhoref*(1 - alf)) &
512 )**(1/gamma + 1) - pi_inf
513 end if
514
515 if (hypoelasticity .and. present(g)) then
516 ! calculate elastic contribution to Energy
517 e_e = 0._wp
518 do s = stress_idx%beg, stress_idx%end
519 if (g > 0) then
520 e_e = e_e + ((stress/rho)**2._wp)/(4._wp*g)
521 ! Double for shear stresses
522 if (any(s == shear_indices)) then
523 e_e = e_e + ((stress/rho)**2._wp)/(4._wp*g)
524 end if
525 end if
526 end do
527
528 pres = ( &
529 energy - &
530 0.5_wp*(mom**2._wp)/rho - &
531 pi_inf - qv - e_e &
532 )/gamma
533
534 end if
535
536# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
537
538 end subroutine s_compute_pressure
539
540 !> This subroutine is designed for the gamma/pi_inf model
541 !! and provided a set of either conservative or primitive
542 !! variables, transfers the density, specific heat ratio
543 !! function and the liquid stiffness function from q_vf to
544 !! rho, gamma and pi_inf.
545 !! @param q_vf conservative or primitive variables
546 !! @param i cell index to transfer mixture variables
547 !! @param j cell index to transfer mixture variables
548 !! @param k cell index to transfer mixture variables
549 !! @param rho density
550 !! @param gamma specific heat ratio function
551 !! @param pi_inf liquid stiffness
552 !! @param qv fluid reference energy
553 subroutine s_convert_mixture_to_mixture_variables(q_vf, i, j, k, &
554 rho, gamma, pi_inf, qv)
555
556 type(scalar_field), dimension(sys_size), intent(in) :: q_vf
557 integer, intent(in) :: i, j, k
558
559 real(wp), intent(out), target :: rho
560 real(wp), intent(out), target :: gamma
561 real(wp), intent(out), target :: pi_inf
562 real(wp), intent(out), target :: qv
563
564 ! Transferring the density, the specific heat ratio function and the
565 ! liquid stiffness function, respectively
566 rho = q_vf(1)%sf(i, j, k)
567 gamma = q_vf(gamma_idx)%sf(i, j, k)
568 pi_inf = q_vf(pi_inf_idx)%sf(i, j, k)
569 qv = 0._wp ! keep this value nill for now. For future adjustment
570
571 ! Post process requires rho_sf/gamma_sf/pi_inf_sf/qv_sf to also be updated
572#ifdef MFC_POST_PROCESS
573 rho_sf(i, j, k) = rho
574 gamma_sf(i, j, k) = gamma
575 pi_inf_sf(i, j, k) = pi_inf
576 qv_sf(i, j, k) = qv
577#endif
578
579 end subroutine s_convert_mixture_to_mixture_variables
580
581 !> This subroutine is designed for the volume fraction model
582 !! and provided a set of either conservative or primitive
583 !! variables, computes the density, the specific heat ratio
584 !! function and the liquid stiffness function from q_vf and
585 !! stores the results into rho, gamma and pi_inf.
586 !! @param q_vf primitive variables
587 !! @param k Cell index
588 !! @param l Cell index
589 !! @param r Cell index
590 !! @param rho density
591 !! @param gamma specific heat ratio
592 !! @param pi_inf liquid stiffness
593 !! @param qv fluid reference energy
594 !! @param Re_K Reynolds number (optional)
595 !! @param G_K Shear modulus (optional)
596 !! @param G Shear moduli of the fluids (optional)
597 subroutine s_convert_species_to_mixture_variables(q_vf, k, l, r, rho, &
598 gamma, pi_inf, qv, Re_K, G_K, G)
599
600 type(scalar_field), dimension(sys_size), intent(in) :: q_vf
601
602 integer, intent(in) :: k, l, r
603
604 real(wp), intent(out), target :: rho
605 real(wp), intent(out), target :: gamma
606 real(wp), intent(out), target :: pi_inf
607 real(wp), intent(out), target :: qv
608
609 real(wp), optional, dimension(2), intent(out) :: re_k
610 real(wp), optional, intent(out) :: g_k
611 real(wp), dimension(num_fluids) :: alpha_rho_k, alpha_k !<
612 real(wp), optional, dimension(num_fluids), intent(in) :: g
613
614 integer :: i, j !< Generic loop iterator
615
616 ! Computing the density, the specific heat ratio function and the
617 ! liquid stiffness function, respectively
618 call s_compute_species_fraction(q_vf, k, l, r, alpha_rho_k, alpha_k)
619
620 ! Calculating the density, the specific heat ratio function, the
621 ! liquid stiffness function, and the energy reference function,
622 ! respectively, from the species analogs
623 if (num_fluids == 1 .and. bubbles_euler) then
624 rho = alpha_rho_k(1)
625 gamma = gammas(1)
626 pi_inf = pi_infs(1)
627 qv = qvs(1)
628 else
629 rho = 0._wp; gamma = 0._wp; pi_inf = 0._wp; qv = 0._wp
630 do i = 1, num_fluids
631 rho = rho + alpha_rho_k(i)
632 gamma = gamma + alpha_k(i)*gammas(i)
633 pi_inf = pi_inf + alpha_k(i)*pi_infs(i)
634 qv = qv + alpha_rho_k(i)*qvs(i)
635 end do
636 end if
637
638#ifdef MFC_SIMULATION
639 ! Computing the shear and bulk Reynolds numbers from species analogs
640 if (viscous) then
641 do i = 1, 2
642 re_k(i) = dflt_real; if (re_size(i) > 0) re_k(i) = 0._wp
643
644 do j = 1, re_size(i)
645 re_k(i) = alpha_k(re_idx(i, j))/fluid_pp(re_idx(i, j))%Re(i) &
646 + re_k(i)
647 end do
648
649 re_k(i) = 1._wp/max(re_k(i), sgm_eps)
650 end do
651 end if
652#endif
653
654 if (present(g_k)) then
655 g_k = 0._wp
656 do i = 1, num_fluids
657 g_k = g_k + alpha_k(i)*g(i)
658 end do
659 g_k = max(0._wp, g_k)
660 end if
661
662 ! Post process requires rho_sf/gamma_sf/pi_inf_sf/qv_sf to also be updated
663#ifdef MFC_POST_PROCESS
664 rho_sf(k, l, r) = rho
665 gamma_sf(k, l, r) = gamma
666 pi_inf_sf(k, l, r) = pi_inf
667 qv_sf(k, l, r) = qv
668#endif
669
670 end subroutine s_convert_species_to_mixture_variables
671
672 !> @brief GPU-accelerated conversion of species volume fractions and partial densities to mixture density, gamma, pi_inf, and qv.
673 subroutine s_convert_species_to_mixture_variables_acc(rho_K, &
674 gamma_K, pi_inf_K, qv_K, &
675 alpha_K, alpha_rho_K, Re_K, &
676 G_K, G)
677
678# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
679#ifdef _CRAYFTN
680# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
681#if MFC_OpenACC
682# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
683!$acc routine seq
684# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
685#elif MFC_OpenMP
686# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
687
688# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
689
690# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
691!$omp declare target device_type(any)
692# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
693#else
694# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
695!DIR$ NOINLINE s_convert_species_to_mixture_variables_acc
696# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
697#endif
698# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
699#elif MFC_OpenACC
700# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
701!$acc routine seq
702# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
703#elif MFC_OpenMP
704# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
705
706# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
707
708# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
709!$omp declare target device_type(any)
710# 328 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
711#endif
712# 330 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
713
714 real(wp), intent(out) :: rho_k, gamma_k, pi_inf_k, qv_k
715# 336 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
716 real(wp), dimension(num_fluids), intent(inout) :: alpha_rho_k, alpha_k !<
717 real(wp), optional, dimension(num_fluids), intent(in) :: g
718# 339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
719 real(wp), dimension(2), intent(out) :: re_k
720 real(wp), optional, intent(out) :: g_k
721 real(wp) :: alpha_k_sum
722
723 integer :: i, j !< Generic loop iterators
724
725#ifdef MFC_SIMULATION
726 ! Constraining the partial densities and the volume fractions within
727 ! their physical bounds to make sure that any mixture variables that
728 ! are derived from them result within the limits that are set by the
729 ! fluids physical parameters that make up the mixture
730 if (num_fluids == 1 .and. bubbles_euler) then
731 rho_k = alpha_rho_k(1)
732 gamma_k = gammas(1)
733 pi_inf_k = pi_infs(1)
734 qv_k = qvs(1)
735 else
736 if (mpp_lim) then
737 alpha_k_sum = 0._wp
738 do i = 1, num_fluids
739 alpha_rho_k(i) = max(0._wp, alpha_rho_k(i))
740 alpha_k(i) = min(max(0._wp, alpha_k(i)), 1._wp)
741 alpha_k_sum = alpha_k_sum + alpha_k(i)
742 end do
743 alpha_k = alpha_k/max(alpha_k_sum, sgm_eps)
744 end if
745 rho_k = 0._wp; gamma_k = 0._wp; pi_inf_k = 0._wp; qv_k = 0._wp
746 do i = 1, num_fluids
747 rho_k = rho_k + alpha_rho_k(i)
748 gamma_k = gamma_k + alpha_k(i)*gammas(i)
749 pi_inf_k = pi_inf_k + alpha_k(i)*pi_infs(i)
750 qv_k = qv_k + alpha_rho_k(i)*qvs(i)
751 end do
752 end if
753
754 if (present(g_k)) then
755 g_k = 0._wp
756 do i = 1, num_fluids
757 !TODO: change to use Gs_vc directly here?
758 !TODO: Make this changes as well for GPUs
759 g_k = g_k + alpha_k(i)*g(i)
760 end do
761 g_k = max(0._wp, g_k)
762 end if
763
764 if (viscous) then
765 do i = 1, 2
766 re_k(i) = dflt_real
767
768 if (re_size(i) > 0) re_k(i) = 0._wp
769
770 do j = 1, re_size(i)
771 re_k(i) = alpha_k(re_idx(i, j))/res_vc(i, j) &
772 + re_k(i)
773 end do
774
775 re_k(i) = 1._wp/max(re_k(i), sgm_eps)
776 end do
777 end if
778#endif
779
780 end subroutine s_convert_species_to_mixture_variables_acc
781
782 !> The computation of parameters, the allocation of memory,
783 !! the association of pointers and/or the execution of any
784 !! other procedures that are necessary to setup the module.
785 impure subroutine s_initialize_variables_conversion_module
786
787 integer :: i, j
788
789
790# 409 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
791#if defined(MFC_OpenACC)
792# 409 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
793!$acc enter data copyin(is1b, is1e, is2b, is2e, is3b, is3e)
794# 409 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
795#elif defined(MFC_OpenMP)
796# 409 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
797!$omp target enter data map(to:is1b, is1e, is2b, is2e, is3b, is3e)
798# 409 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
799#endif
800
801#ifdef MFC_DEBUG
802# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
803 block
804# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
805 use iso_fortran_env, only: output_unit
806# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
807
808# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
809 print *, 'm_variables_conversion.fpp:411: ', '@:ALLOCATE(gammas (1:num_fluids))'
810# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
811
812# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
813 call flush (output_unit)
814# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
815 end block
816# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
817#endif
818# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
819 allocate (gammas(1:num_fluids))
820# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
821
822# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
823
824# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
825#if defined(MFC_OpenACC)
826# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
827!$acc enter data create(gammas)
828# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
829#elif defined(MFC_OpenMP)
830# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
831!$omp target enter data map(always,alloc:gammas)
832# 411 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
833#endif
834#ifdef MFC_DEBUG
835# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
836 block
837# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
838 use iso_fortran_env, only: output_unit
839# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
840
841# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
842 print *, 'm_variables_conversion.fpp:412: ', '@:ALLOCATE(gs_min (1:num_fluids))'
843# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
844
845# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
846 call flush (output_unit)
847# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
848 end block
849# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
850#endif
851# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
852 allocate (gs_min(1:num_fluids))
853# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
854
855# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
856
857# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
858#if defined(MFC_OpenACC)
859# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
860!$acc enter data create(gs_min)
861# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
862#elif defined(MFC_OpenMP)
863# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
864!$omp target enter data map(always,alloc:gs_min)
865# 412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
866#endif
867#ifdef MFC_DEBUG
868# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
869 block
870# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
871 use iso_fortran_env, only: output_unit
872# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
873
874# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
875 print *, 'm_variables_conversion.fpp:413: ', '@:ALLOCATE(pi_infs(1:num_fluids))'
876# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
877
878# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
879 call flush (output_unit)
880# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
881 end block
882# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
883#endif
884# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
885 allocate (pi_infs(1:num_fluids))
886# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
887
888# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
889
890# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
891#if defined(MFC_OpenACC)
892# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
893!$acc enter data create(pi_infs)
894# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
895#elif defined(MFC_OpenMP)
896# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
897!$omp target enter data map(always,alloc:pi_infs)
898# 413 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
899#endif
900#ifdef MFC_DEBUG
901# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
902 block
903# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
904 use iso_fortran_env, only: output_unit
905# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
906
907# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
908 print *, 'm_variables_conversion.fpp:414: ', '@:ALLOCATE(ps_inf(1:num_fluids))'
909# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
910
911# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
912 call flush (output_unit)
913# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
914 end block
915# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
916#endif
917# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
918 allocate (ps_inf(1:num_fluids))
919# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
920
921# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
922
923# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
924#if defined(MFC_OpenACC)
925# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
926!$acc enter data create(ps_inf)
927# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
928#elif defined(MFC_OpenMP)
929# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
930!$omp target enter data map(always,alloc:ps_inf)
931# 414 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
932#endif
933#ifdef MFC_DEBUG
934# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
935 block
936# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
937 use iso_fortran_env, only: output_unit
938# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
939
940# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
941 print *, 'm_variables_conversion.fpp:415: ', '@:ALLOCATE(cvs (1:num_fluids))'
942# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
943
944# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
945 call flush (output_unit)
946# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
947 end block
948# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
949#endif
950# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
951 allocate (cvs(1:num_fluids))
952# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
953
954# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
955
956# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
957#if defined(MFC_OpenACC)
958# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
959!$acc enter data create(cvs)
960# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
961#elif defined(MFC_OpenMP)
962# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
963!$omp target enter data map(always,alloc:cvs)
964# 415 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
965#endif
966#ifdef MFC_DEBUG
967# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
968 block
969# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
970 use iso_fortran_env, only: output_unit
971# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
972
973# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
974 print *, 'm_variables_conversion.fpp:416: ', '@:ALLOCATE(qvs (1:num_fluids))'
975# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
976
977# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
978 call flush (output_unit)
979# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
980 end block
981# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
982#endif
983# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
984 allocate (qvs(1:num_fluids))
985# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
986
987# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
988
989# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
990#if defined(MFC_OpenACC)
991# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
992!$acc enter data create(qvs)
993# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
994#elif defined(MFC_OpenMP)
995# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
996!$omp target enter data map(always,alloc:qvs)
997# 416 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
998#endif
999#ifdef MFC_DEBUG
1000# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1001 block
1002# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1003 use iso_fortran_env, only: output_unit
1004# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1005
1006# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1007 print *, 'm_variables_conversion.fpp:417: ', '@:ALLOCATE(qvps (1:num_fluids))'
1008# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1009
1010# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1011 call flush (output_unit)
1012# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1013 end block
1014# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1015#endif
1016# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1017 allocate (qvps(1:num_fluids))
1018# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1019
1020# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1021
1022# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1023#if defined(MFC_OpenACC)
1024# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1025!$acc enter data create(qvps)
1026# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1027#elif defined(MFC_OpenMP)
1028# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1029!$omp target enter data map(always,alloc:qvps)
1030# 417 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1031#endif
1032#ifdef MFC_DEBUG
1033# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1034 block
1035# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1036 use iso_fortran_env, only: output_unit
1037# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1038
1039# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1040 print *, 'm_variables_conversion.fpp:418: ', '@:ALLOCATE(Gs_vc (1:num_fluids))'
1041# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1042
1043# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1044 call flush (output_unit)
1045# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1046 end block
1047# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1048#endif
1049# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1050 allocate (gs_vc(1:num_fluids))
1051# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1052
1053# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1054
1055# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1056#if defined(MFC_OpenACC)
1057# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1058!$acc enter data create(Gs_vc)
1059# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1060#elif defined(MFC_OpenMP)
1061# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1062!$omp target enter data map(always,alloc:Gs_vc)
1063# 418 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1064#endif
1065
1066 do i = 1, num_fluids
1067 gammas(i) = fluid_pp(i)%gamma
1068 gs_min(i) = 1.0_wp/gammas(i) + 1.0_wp
1069 pi_infs(i) = fluid_pp(i)%pi_inf
1070 gs_vc(i) = fluid_pp(i)%G
1071 ps_inf(i) = pi_infs(i)/(1.0_wp + gammas(i))
1072 cvs(i) = fluid_pp(i)%cv
1073 qvs(i) = fluid_pp(i)%qv
1074 qvps(i) = fluid_pp(i)%qvp
1075 end do
1076
1077# 430 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1078#if defined(MFC_OpenACC)
1079# 430 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1080!$acc update device(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, Gs_vc)
1081# 430 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1082#elif defined(MFC_OpenMP)
1083# 430 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1084!$omp target update to(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, Gs_vc)
1085# 430 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1086#endif
1087
1088#ifdef MFC_SIMULATION
1089
1090 if (viscous) then
1091#ifdef MFC_DEBUG
1092# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1093 block
1094# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1095 use iso_fortran_env, only: output_unit
1096# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1097
1098# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1099 print *, 'm_variables_conversion.fpp:435: ', '@:ALLOCATE(Res_vc(1:2, 1:Re_size_max))'
1100# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1101
1102# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1103 call flush (output_unit)
1104# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1105 end block
1106# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1107#endif
1108# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1109 allocate (res_vc(1:2, 1:re_size_max))
1110# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1111
1112# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1113
1114# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1115#if defined(MFC_OpenACC)
1116# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1117!$acc enter data create(Res_vc)
1118# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1119#elif defined(MFC_OpenMP)
1120# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1121!$omp target enter data map(always,alloc:Res_vc)
1122# 435 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1123#endif
1124 do i = 1, 2
1125 do j = 1, re_size(i)
1126 res_vc(i, j) = fluid_pp(re_idx(i, j))%Re(i)
1127 end do
1128 end do
1129
1130
1131# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1132#if defined(MFC_OpenACC)
1133# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1134!$acc update device(Res_vc, Re_idx, Re_size)
1135# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1136#elif defined(MFC_OpenMP)
1137# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1138!$omp target update to(Res_vc, Re_idx, Re_size)
1139# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1140#endif
1141 end if
1142#endif
1143
1144 if (bubbles_euler) then
1145#ifdef MFC_DEBUG
1146# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1147 block
1148# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1149 use iso_fortran_env, only: output_unit
1150# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1151
1152# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1153 print *, 'm_variables_conversion.fpp:447: ', '@:ALLOCATE(bubrs_vc(1:nb))'
1154# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1155
1156# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1157 call flush (output_unit)
1158# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1159 end block
1160# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1161#endif
1162# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1163 allocate (bubrs_vc(1:nb))
1164# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1165
1166# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1167
1168# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1169#if defined(MFC_OpenACC)
1170# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1171!$acc enter data create(bubrs_vc)
1172# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1173#elif defined(MFC_OpenMP)
1174# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1175!$omp target enter data map(always,alloc:bubrs_vc)
1176# 447 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1177#endif
1178 do i = 1, nb
1179 bubrs_vc(i) = bub_idx%rs(i)
1180 end do
1181
1182# 451 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1183#if defined(MFC_OpenACC)
1184# 451 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1185!$acc update device(bubrs_vc)
1186# 451 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1187#elif defined(MFC_OpenMP)
1188# 451 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1189!$omp target update to(bubrs_vc)
1190# 451 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1191#endif
1192 end if
1193
1194#ifdef MFC_POST_PROCESS
1195 ! Allocating the density, the specific heat ratio function and the
1196 ! liquid stiffness function, respectively
1197
1198 ! Simulation is at least 2D
1199 if (n > 0) then
1200
1201 ! Simulation is 3D
1202 if (p > 0) then
1203
1204 allocate (rho_sf(-buff_size:m + buff_size, &
1205 -buff_size:n + buff_size, &
1206 -buff_size:p + buff_size))
1207 allocate (gamma_sf(-buff_size:m + buff_size, &
1208 -buff_size:n + buff_size, &
1209 -buff_size:p + buff_size))
1210 allocate (pi_inf_sf(-buff_size:m + buff_size, &
1211 -buff_size:n + buff_size, &
1212 -buff_size:p + buff_size))
1213 allocate (qv_sf(-buff_size:m + buff_size, &
1214 -buff_size:n + buff_size, &
1215 -buff_size:p + buff_size))
1216
1217 ! Simulation is 2D
1218 else
1219
1220 allocate (rho_sf(-buff_size:m + buff_size, &
1221 -buff_size:n + buff_size, &
1222 0:0))
1223 allocate (gamma_sf(-buff_size:m + buff_size, &
1224 -buff_size:n + buff_size, &
1225 0:0))
1226 allocate (pi_inf_sf(-buff_size:m + buff_size, &
1227 -buff_size:n + buff_size, &
1228 0:0))
1229 allocate (qv_sf(-buff_size:m + buff_size, &
1230 -buff_size:n + buff_size, &
1231 0:0))
1232 end if
1233
1234 ! Simulation is 1D
1235 else
1236
1237 allocate (rho_sf(-buff_size:m + buff_size, &
1238 0:0, &
1239 0:0))
1240 allocate (gamma_sf(-buff_size:m + buff_size, &
1241 0:0, &
1242 0:0))
1243 allocate (pi_inf_sf(-buff_size:m + buff_size, &
1244 0:0, &
1245 0:0))
1246 allocate (qv_sf(-buff_size:m + buff_size, &
1247 0:0, &
1248 0:0))
1249
1250 end if
1251#endif
1252
1253 end subroutine s_initialize_variables_conversion_module
1254
1255 !> @brief Initializes bubble mass-vapor values at quadrature nodes from the conserved moment statistics.
1256 subroutine s_initialize_mv(qK_cons_vf, mv)
1257
1258 type(scalar_field), dimension(sys_size), intent(in) :: qk_cons_vf
1259
1260 real(stp), dimension(idwint(1)%beg:, idwint(2)%beg:, idwint(3)%beg:, 1:, 1:), intent(inout) :: mv
1261
1262 integer :: i, j, k, l
1263 real(wp) :: mu, sig, nbub_sc
1264
1265 do l = idwint(3)%beg, idwint(3)%end
1266 do k = idwint(2)%beg, idwint(2)%end
1267 do j = idwint(1)%beg, idwint(1)%end
1268
1269 nbub_sc = qk_cons_vf(bubxb)%sf(j, k, l)
1270
1271
1272# 531 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1273#if defined(MFC_OpenACC)
1274# 531 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1275!$acc loop seq
1276# 531 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1277#elif defined(MFC_OpenMP)
1278# 531 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1279
1280# 531 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1281#endif
1282 do i = 1, nb
1283 mu = qk_cons_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc
1284 sig = (qk_cons_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5_wp
1285
1286 mv(j, k, l, 1, i) = (mass_v0(i))*(mu - sig)**(3._wp)/(r0(i)**(3._wp))
1287 mv(j, k, l, 2, i) = (mass_v0(i))*(mu - sig)**(3._wp)/(r0(i)**(3._wp))
1288 mv(j, k, l, 3, i) = (mass_v0(i))*(mu + sig)**(3._wp)/(r0(i)**(3._wp))
1289 mv(j, k, l, 4, i) = (mass_v0(i))*(mu + sig)**(3._wp)/(r0(i)**(3._wp))
1290 end do
1291
1292 end do
1293 end do
1294 end do
1295
1296 end subroutine s_initialize_mv
1297
1298 !> @brief Initializes bubble internal pressures at quadrature nodes using isothermal relations from the Preston model.
1299 subroutine s_initialize_pb(qK_cons_vf, mv, pb)
1300 type(scalar_field), dimension(sys_size), intent(in) :: qk_cons_vf
1301
1302 real(stp), dimension(idwint(1)%beg:, idwint(2)%beg:, idwint(3)%beg:, 1:, 1:), intent(in) :: mv
1303 real(stp), dimension(idwint(1)%beg:, idwint(2)%beg:, idwint(3)%beg:, 1:, 1:), intent(inout) :: pb
1304
1305 integer :: i, j, k, l
1306 real(wp) :: mu, sig, nbub_sc
1307
1308 do l = idwint(3)%beg, idwint(3)%end
1309 do k = idwint(2)%beg, idwint(2)%end
1310 do j = idwint(1)%beg, idwint(1)%end
1311
1312 nbub_sc = qk_cons_vf(bubxb)%sf(j, k, l)
1313
1314
1315# 564 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1316#if defined(MFC_OpenACC)
1317# 564 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1318!$acc loop seq
1319# 564 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1320#elif defined(MFC_OpenMP)
1321# 564 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1322
1323# 564 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1324#endif
1325 do i = 1, nb
1326 mu = qk_cons_vf(bubxb + 1 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc
1327 sig = (qk_cons_vf(bubxb + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5_wp
1328
1329 !PRESTON (ISOTHERMAL)
1330 pb(j, k, l, 1, i) = (pb0(i))*(r0(i)**(3._wp))*(mass_g0(i) + mv(j, k, l, 1, i))/(mu - sig)**(3._wp)/(mass_g0(i) + mass_v0(i))
1331 pb(j, k, l, 2, i) = (pb0(i))*(r0(i)**(3._wp))*(mass_g0(i) + mv(j, k, l, 2, i))/(mu - sig)**(3._wp)/(mass_g0(i) + mass_v0(i))
1332 pb(j, k, l, 3, i) = (pb0(i))*(r0(i)**(3._wp))*(mass_g0(i) + mv(j, k, l, 3, i))/(mu + sig)**(3._wp)/(mass_g0(i) + mass_v0(i))
1333 pb(j, k, l, 4, i) = (pb0(i))*(r0(i)**(3._wp))*(mass_g0(i) + mv(j, k, l, 4, i))/(mu + sig)**(3._wp)/(mass_g0(i) + mass_v0(i))
1334 end do
1335 end do
1336 end do
1337 end do
1338
1339 end subroutine s_initialize_pb
1340
1341 !> The following procedure handles the conversion between
1342 !! the conservative variables and the primitive variables.
1343 !! @param qK_cons_vf Conservative variables
1344 !! @param q_T_sf Temperature scalar field
1345 !! @param qK_prim_vf Primitive variables
1346 !! @param ibounds Index bounds in each coordinate direction
1347 subroutine s_convert_conservative_to_primitive_variables(qK_cons_vf, &
1348 q_T_sf, &
1349 qK_prim_vf, &
1350 ibounds)
1351
1352 type(scalar_field), dimension(sys_size), intent(in) :: qk_cons_vf
1353 type(scalar_field), intent(inout) :: q_t_sf
1354 type(scalar_field), dimension(sys_size), intent(inout) :: qk_prim_vf
1355 type(int_bounds_info), dimension(1:3), intent(in) :: ibounds
1356# 601 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1357 real(wp), dimension(num_fluids) :: alpha_k, alpha_rho_k
1358 real(wp), dimension(nb) :: nrtmp
1359 real(wp) :: rhoyks(1:num_species)
1360# 605 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1361 real(wp), dimension(2) :: re_k
1362 real(wp) :: rho_k, gamma_k, pi_inf_k, qv_k, dyn_pres_k
1363
1364 real(wp) :: vftmp, nbub_sc
1365
1366 real(wp) :: g_k
1367
1368 real(wp) :: pres
1369
1370 integer :: i, j, k, l !< Generic loop iterators
1371
1372 real(wp) :: t
1373 real(wp) :: pres_mag
1374
1375 real(wp) :: ga ! Lorentz factor (gamma in relativity)
1376 real(wp) :: b2 ! Magnetic field magnitude squared
1377 real(wp) :: b(3) ! Magnetic field components
1378 real(wp) :: m2 ! Relativistic momentum magnitude squared
1379 real(wp) :: s ! Dot product of the magnetic field and the relativistic momentum
1380 real(wp) :: w, dw ! W := rho*v*Ga**2; f = f(W) in Newton-Raphson
1381 real(wp) :: e, d ! Prim/Cons variables within Newton-Raphson iteration
1382 real(wp) :: f, dga_dw, dp_dw, df_dw ! Functions within Newton-Raphson iteration
1383 integer :: iter ! Newton-Raphson iteration counter
1384
1385
1386# 629 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1387
1388# 629 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1389#if defined(MFC_OpenACC)
1390# 629 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1391!$acc parallel loop collapse(3) gang vector default(present) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, rhoYks, B, pres, vftmp, nbub_sc, G_K, T, pres_mag, Ga, B2, m2, S, W, dW, E, D, f, dGa_dW, dp_dW, df_dW, iter)
1392# 629 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1393#elif defined(MFC_OpenMP)
1394# 629 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1395
1396# 629 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1397
1398# 629 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1399
1400# 629 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1401!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(alpha_K, alpha_rho_K, Re_K, nRtmp, rho_K, gamma_K, pi_inf_K, qv_K, dyn_pres_K, rhoYks, B, pres, vftmp, nbub_sc, G_K, T, pres_mag, Ga, B2, m2, S, W, dW, E, D, f, dGa_dW, dp_dW, df_dW, iter)
1402# 629 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1403#endif
1404# 629 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1405
1406 do l = ibounds(3)%beg, ibounds(3)%end
1407 do k = ibounds(2)%beg, ibounds(2)%end
1408 do j = ibounds(1)%beg, ibounds(1)%end
1409 dyn_pres_k = 0._wp
1410
1411 call s_compute_species_fraction(qk_cons_vf, j, k, l, alpha_rho_k, alpha_k)
1412
1413 if (model_eqns /= 4) then
1414#ifdef MFC_SIMULATION
1415 ! If in simulation, use acc mixture subroutines
1416 if (elasticity) then
1417 call s_convert_species_to_mixture_variables_acc(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, &
1418 alpha_rho_k, re_k, g_k, gs_vc)
1419 else
1420 call s_convert_species_to_mixture_variables_acc(rho_k, gamma_k, pi_inf_k, qv_k, &
1421 alpha_k, alpha_rho_k, re_k)
1422 end if
1423#else
1424 ! If pre-processing, use non acc mixture subroutines
1425 if (elasticity) then
1426 call s_convert_to_mixture_variables(qk_cons_vf, j, k, l, &
1427 rho_k, gamma_k, pi_inf_k, qv_k, re_k, g_k, fluid_pp(:)%G)
1428 else
1429 call s_convert_to_mixture_variables(qk_cons_vf, j, k, l, &
1430 rho_k, gamma_k, pi_inf_k, qv_k)
1431 end if
1432#endif
1433 end if
1434
1435 if (relativity) then
1436 if (n == 0) then
1437 b(1) = bx0
1438 b(2) = qk_cons_vf(b_idx%beg)%sf(j, k, l)
1439 b(3) = qk_cons_vf(b_idx%beg + 1)%sf(j, k, l)
1440 else
1441 b(1) = qk_cons_vf(b_idx%beg)%sf(j, k, l)
1442 b(2) = qk_cons_vf(b_idx%beg + 1)%sf(j, k, l)
1443 b(3) = qk_cons_vf(b_idx%beg + 2)%sf(j, k, l)
1444 end if
1445 b2 = b(1)**2 + b(2)**2 + b(3)**2
1446
1447 m2 = 0._wp
1448
1449# 672 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1450#if defined(MFC_OpenACC)
1451# 672 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1452!$acc loop seq
1453# 672 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1454#elif defined(MFC_OpenMP)
1455# 672 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1456
1457# 672 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1458#endif
1459 do i = momxb, momxe
1460 m2 = m2 + qk_cons_vf(i)%sf(j, k, l)**2
1461 end do
1462
1463 s = 0._wp
1464
1465# 678 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1466#if defined(MFC_OpenACC)
1467# 678 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1468!$acc loop seq
1469# 678 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1470#elif defined(MFC_OpenMP)
1471# 678 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1472
1473# 678 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1474#endif
1475 do i = 1, 3
1476 s = s + qk_cons_vf(momxb + i - 1)%sf(j, k, l)*b(i)
1477 end do
1478
1479 e = qk_cons_vf(e_idx)%sf(j, k, l)
1480
1481 d = 0._wp
1482
1483# 686 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1484#if defined(MFC_OpenACC)
1485# 686 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1486!$acc loop seq
1487# 686 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1488#elif defined(MFC_OpenMP)
1489# 686 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1490
1491# 686 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1492#endif
1493 do i = 1, contxe
1494 d = d + qk_cons_vf(i)%sf(j, k, l)
1495 end do
1496
1497 ! Newton-Raphson
1498 w = e + d
1499
1500# 693 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1501#if defined(MFC_OpenACC)
1502# 693 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1503!$acc loop seq
1504# 693 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1505#elif defined(MFC_OpenMP)
1506# 693 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1507
1508# 693 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1509#endif
1510 do iter = 1, relativity_cons_to_prim_max_iter
1511 ga = (w + b2)*w/sqrt((w + b2)**2*w**2 - (m2*w**2 + s**2*(2*w + b2)))
1512 pres = (w - d*ga)/((gamma_k + 1)*ga**2) ! Thermal pressure from EOS
1513 f = w - pres + (1 - 1/(2*ga**2))*b2 - s**2/(2*w**2) - e - d
1514
1515 ! The first equation below corrects a typo in (Mignone & Bodo, 2006)
1516 ! m2*W**2 → 2*m2*W**2, which would cancel with the 2* in other terms
1517 ! This corrected version is not used as the second equation empirically converges faster.
1518 ! First equation is kept for further investigation.
1519 ! dGa_dW = -Ga**3 * ( S**2*(3*W**2+3*W*B2+B2**2) + m2*W**2 ) / (W**3 * (W+B2)**3) ! first (corrected)
1520 dga_dw = -ga**3*(2*s**2*(3*w**2 + 3*w*b2 + b2**2) + m2*w**2)/(2*w**3*(w + b2)**3) ! second (in paper)
1521
1522 dp_dw = (ga*(1 + d*dga_dw) - 2*w*dga_dw)/((gamma_k + 1)*ga**3)
1523 df_dw = 1 - dp_dw + (b2/ga**3)*dga_dw + s**2/w**3
1524
1525 dw = -f/df_dw
1526 w = w + dw
1527 if (abs(dw) < 1.e-12_wp*w) exit
1528 end do
1529
1530 ! Recalculate pressure using converged W
1531 ga = (w + b2)*w/sqrt((w + b2)**2*w**2 - (m2*w**2 + s**2*(2*w + b2)))
1532 qk_prim_vf(e_idx)%sf(j, k, l) = (w - d*ga)/((gamma_k + 1)*ga**2)
1533
1534 ! Recover the other primitive variables
1535
1536# 719 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1537#if defined(MFC_OpenACC)
1538# 719 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1539!$acc loop seq
1540# 719 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1541#elif defined(MFC_OpenMP)
1542# 719 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1543
1544# 719 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1545#endif
1546 do i = 1, 3
1547 qk_prim_vf(momxb + i - 1)%sf(j, k, l) = (qk_cons_vf(momxb + i - 1)%sf(j, k, l) + (s/w)*b(i))/(w + b2)
1548 end do
1549 qk_prim_vf(1)%sf(j, k, l) = d/ga ! Hard-coded for single-component for now
1550
1551
1552# 725 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1553#if defined(MFC_OpenACC)
1554# 725 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1555!$acc loop seq
1556# 725 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1557#elif defined(MFC_OpenMP)
1558# 725 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1559
1560# 725 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1561#endif
1562 do i = b_idx%beg, b_idx%end
1563 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)
1564 end do
1565
1566 cycle ! skip all the non-relativistic conversions below
1567 end if
1568
1569 if (chemistry) then
1570 rho_k = 0._wp
1571
1572# 735 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1573#if defined(MFC_OpenACC)
1574# 735 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1575!$acc loop seq
1576# 735 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1577#elif defined(MFC_OpenMP)
1578# 735 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1579
1580# 735 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1581#endif
1582 do i = chemxb, chemxe
1583 rho_k = rho_k + max(0._wp, qk_cons_vf(i)%sf(j, k, l))
1584 end do
1585
1586
1587# 740 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1588#if defined(MFC_OpenACC)
1589# 740 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1590!$acc loop seq
1591# 740 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1592#elif defined(MFC_OpenMP)
1593# 740 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1594
1595# 740 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1596#endif
1597 do i = 1, contxe
1598 qk_prim_vf(i)%sf(j, k, l) = rho_k
1599 end do
1600
1601
1602# 745 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1603#if defined(MFC_OpenACC)
1604# 745 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1605!$acc loop seq
1606# 745 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1607#elif defined(MFC_OpenMP)
1608# 745 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1609
1610# 745 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1611#endif
1612 do i = chemxb, chemxe
1613 qk_prim_vf(i)%sf(j, k, l) = max(0._wp, qk_cons_vf(i)%sf(j, k, l)/rho_k)
1614 end do
1615 else
1616
1617# 750 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1618#if defined(MFC_OpenACC)
1619# 750 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1620!$acc loop seq
1621# 750 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1622#elif defined(MFC_OpenMP)
1623# 750 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1624
1625# 750 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1626#endif
1627 do i = 1, contxe
1628 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)
1629 end do
1630 end if
1631
1632#ifdef MFC_SIMULATION
1633 rho_k = max(rho_k, sgm_eps)
1634#endif
1635
1636
1637# 760 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1638#if defined(MFC_OpenACC)
1639# 760 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1640!$acc loop seq
1641# 760 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1642#elif defined(MFC_OpenMP)
1643# 760 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1644
1645# 760 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1646#endif
1647 do i = momxb, momxe
1648 if (model_eqns /= 4) then
1649 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l) &
1650 /rho_k
1651 dyn_pres_k = dyn_pres_k + 5.e-1_wp*qk_cons_vf(i)%sf(j, k, l) &
1652 *qk_prim_vf(i)%sf(j, k, l)
1653 else
1654 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l) &
1655 /qk_cons_vf(1)%sf(j, k, l)
1656 end if
1657 end do
1658
1659 if (chemistry) then
1660
1661# 774 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1662#if defined(MFC_OpenACC)
1663# 774 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1664!$acc loop seq
1665# 774 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1666#elif defined(MFC_OpenMP)
1667# 774 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1668
1669# 774 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1670#endif
1671 do i = 1, num_species
1672 rhoyks(i) = qk_cons_vf(chemxb + i - 1)%sf(j, k, l)
1673 end do
1674
1675 t = q_t_sf%sf(j, k, l)
1676 end if
1677
1678 if (mhd) then
1679 if (n == 0) then
1680 pres_mag = 0.5_wp*(bx0**2 + qk_cons_vf(b_idx%beg)%sf(j, k, l)**2 + qk_cons_vf(b_idx%beg + 1)%sf(j, k, l)**2)
1681 else
1682 pres_mag = 0.5_wp*(qk_cons_vf(b_idx%beg)%sf(j, k, l)**2 + qk_cons_vf(b_idx%beg + 1)%sf(j, k, l)**2 + qk_cons_vf(b_idx%beg + 2)%sf(j, k, l)**2)
1683 end if
1684 else
1685 pres_mag = 0._wp
1686 end if
1687
1688 call s_compute_pressure(qk_cons_vf(e_idx)%sf(j, k, l), &
1689 qk_cons_vf(alf_idx)%sf(j, k, l), &
1690 dyn_pres_k, pi_inf_k, gamma_k, rho_k, &
1691 qv_k, rhoyks, pres, t, pres_mag=pres_mag)
1692
1693 qk_prim_vf(e_idx)%sf(j, k, l) = pres
1694
1695 if (chemistry) then
1696 q_t_sf%sf(j, k, l) = t
1697 end if
1698
1699 if (bubbles_euler) then
1700
1701# 804 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1702#if defined(MFC_OpenACC)
1703# 804 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1704!$acc loop seq
1705# 804 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1706#elif defined(MFC_OpenMP)
1707# 804 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1708
1709# 804 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1710#endif
1711 do i = 1, nb
1712 nrtmp(i) = qk_cons_vf(bubrs_vc(i))%sf(j, k, l)
1713 end do
1714
1715 vftmp = qk_cons_vf(alf_idx)%sf(j, k, l)
1716
1717 if (qbmm) then
1718 !Get nb (constant across all R0 bins)
1719 nbub_sc = qk_cons_vf(bubxb)%sf(j, k, l)
1720
1721 !Convert cons to prim
1722
1723# 816 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1724#if defined(MFC_OpenACC)
1725# 816 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1726!$acc loop seq
1727# 816 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1728#elif defined(MFC_OpenMP)
1729# 816 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1730
1731# 816 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1732#endif
1733 do i = bubxb, bubxe
1734 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)/nbub_sc
1735 end do
1736 !Need to keep track of nb in the primitive variable list (converted back to true value before output)
1737#ifdef MFC_SIMULATION
1738 qk_prim_vf(bubxb)%sf(j, k, l) = qk_cons_vf(bubxb)%sf(j, k, l)
1739#endif
1740
1741 else
1742 if (adv_n) then
1743 qk_prim_vf(n_idx)%sf(j, k, l) = qk_cons_vf(n_idx)%sf(j, k, l)
1744 nbub_sc = qk_prim_vf(n_idx)%sf(j, k, l)
1745 else
1746 call s_comp_n_from_cons(vftmp, nrtmp, nbub_sc, weight)
1747 end if
1748
1749
1750# 833 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1751#if defined(MFC_OpenACC)
1752# 833 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1753!$acc loop seq
1754# 833 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1755#elif defined(MFC_OpenMP)
1756# 833 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1757
1758# 833 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1759#endif
1760 do i = bubxb, bubxe
1761 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)/nbub_sc
1762 end do
1763 end if
1764 end if
1765
1766 if (mhd) then
1767
1768# 841 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1769#if defined(MFC_OpenACC)
1770# 841 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1771!$acc loop seq
1772# 841 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1773#elif defined(MFC_OpenMP)
1774# 841 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1775
1776# 841 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1777#endif
1778 do i = b_idx%beg, b_idx%end
1779 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)
1780 end do
1781 end if
1782
1783 if (elasticity) then
1784
1785# 848 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1786#if defined(MFC_OpenACC)
1787# 848 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1788!$acc loop seq
1789# 848 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1790#elif defined(MFC_OpenMP)
1791# 848 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1792
1793# 848 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1794#endif
1795 do i = strxb, strxe
1796 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)/rho_k
1797 end do
1798 end if
1799
1800 if (hypoelasticity) then
1801 if (cont_damage) g_k = g_k*max((1._wp - qk_cons_vf(damage_idx)%sf(j, k, l)), 0._wp)
1802
1803# 856 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1804#if defined(MFC_OpenACC)
1805# 856 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1806!$acc loop seq
1807# 856 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1808#elif defined(MFC_OpenMP)
1809# 856 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1810
1811# 856 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1812#endif
1813 do i = strxb, strxe
1814 ! subtracting elastic contribution for pressure calculation
1815 if (g_k > verysmall) then
1816 qk_prim_vf(e_idx)%sf(j, k, l) = qk_prim_vf(e_idx)%sf(j, k, l) - &
1817 ((qk_prim_vf(i)%sf(j, k, l)**2._wp)/(4._wp*g_k))/gamma_k
1818 ! Double for shear stresses
1819 if (any(i == shear_indices)) then
1820 qk_prim_vf(e_idx)%sf(j, k, l) = qk_prim_vf(e_idx)%sf(j, k, l) - &
1821 ((qk_prim_vf(i)%sf(j, k, l)**2._wp)/(4._wp*g_k))/gamma_k
1822 end if
1823 end if
1824 end do
1825 end if
1826
1827 if (hyperelasticity) then
1828
1829# 872 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1830#if defined(MFC_OpenACC)
1831# 872 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1832!$acc loop seq
1833# 872 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1834#elif defined(MFC_OpenMP)
1835# 872 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1836
1837# 872 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1838#endif
1839 do i = xibeg, xiend
1840 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)/rho_k
1841 end do
1842 end if
1843
1844 if (.not. igr .or. num_fluids > 1) then
1845
1846# 879 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1847#if defined(MFC_OpenACC)
1848# 879 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1849!$acc loop seq
1850# 879 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1851#elif defined(MFC_OpenMP)
1852# 879 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1853
1854# 879 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1855#endif
1856 do i = advxb, advxe
1857 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)
1858 end do
1859 end if
1860
1861 if (surface_tension) then
1862 qk_prim_vf(c_idx)%sf(j, k, l) = qk_cons_vf(c_idx)%sf(j, k, l)
1863 end if
1864
1865 if (cont_damage) qk_prim_vf(damage_idx)%sf(j, k, l) = qk_cons_vf(damage_idx)%sf(j, k, l)
1866
1867 if (hyper_cleaning) qk_prim_vf(psi_idx)%sf(j, k, l) = qk_cons_vf(psi_idx)%sf(j, k, l)
1868#ifdef MFC_POST_PROCESS
1869 if (bubbles_lagrange) qk_prim_vf(beta_idx)%sf(j, k, l) = qk_cons_vf(beta_idx)%sf(j, k, l)
1870#endif
1871
1872 end do
1873 end do
1874 end do
1875
1876# 899 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1877
1878# 899 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1879#if defined(MFC_OpenACC)
1880# 899 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1881!$acc end parallel loop
1882# 899 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1883#elif defined(MFC_OpenMP)
1884# 899 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1885
1886# 899 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1887
1888# 899 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1889!$omp end target teams loop
1890# 899 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1891#endif
1892# 899 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1893
1894
1895 end subroutine s_convert_conservative_to_primitive_variables
1896
1897 !> The following procedure handles the conversion between
1898 !! the primitive variables and the conservative variables.
1899 !! @param q_prim_vf Primitive variables
1900 !! @param q_cons_vf Conservative variables
1901 impure subroutine s_convert_primitive_to_conservative_variables(q_prim_vf, &
1902 q_cons_vf)
1903
1904 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1905 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
1906
1907 ! Density, specific heat ratio function, liquid stiffness function
1908 ! and dynamic pressure, as defined in the incompressible flow sense,
1909 ! respectively
1910 real(wp) :: rho
1911 real(wp) :: gamma
1912 real(wp) :: pi_inf
1913 real(wp) :: qv
1914 real(wp) :: dyn_pres
1915 real(wp) :: nbub, r3tmp
1916 real(wp), dimension(nb) :: rtmp
1917 real(wp) :: g
1918 real(wp), dimension(2) :: re_k
1919
1920 integer :: i, j, k, l !< Generic loop iterators
1921
1922 real(wp), dimension(num_species) :: ys
1923 real(wp) :: e_mix, mix_mol_weight, t
1924 real(wp) :: pres_mag
1925
1926 real(wp) :: ga ! Lorentz factor (gamma in relativity)
1927 real(wp) :: h ! relativistic enthalpy
1928 real(wp) :: v2 ! Square of the velocity magnitude
1929 real(wp) :: b2 ! Square of the magnetic field magnitude
1930 real(wp) :: vdotb ! Dot product of the velocity and magnetic field vectors
1931 real(wp) :: b(3) ! Magnetic field components
1932
1933 pres_mag = 0._wp
1934
1935 g = 0._wp
1936
1937#ifndef MFC_SIMULATION
1938 ! Converting the primitive variables to the conservative variables
1939 do l = 0, p
1940 do k = 0, n
1941 do j = 0, m
1942
1943 ! Obtaining the density, specific heat ratio function
1944 ! and the liquid stiffness function, respectively
1945 call s_convert_to_mixture_variables(q_prim_vf, j, k, l, &
1946 rho, gamma, pi_inf, qv, re_k, g, fluid_pp(:)%G)
1947
1948 if (.not. igr .or. num_fluids > 1) then
1949 ! Transferring the advection equation(s) variable(s)
1950 do i = adv_idx%beg, adv_idx%end
1951 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
1952 end do
1953 end if
1954
1955 if (relativity) then
1956
1957 if (n == 0) then
1958 b(1) = bx0
1959 b(2) = q_prim_vf(b_idx%beg)%sf(j, k, l)
1960 b(3) = q_prim_vf(b_idx%beg + 1)%sf(j, k, l)
1961 else
1962 b(1) = q_prim_vf(b_idx%beg)%sf(j, k, l)
1963 b(2) = q_prim_vf(b_idx%beg + 1)%sf(j, k, l)
1964 b(3) = q_prim_vf(b_idx%beg + 2)%sf(j, k, l)
1965 end if
1966
1967 v2 = 0._wp
1968 do i = momxb, momxe
1969 v2 = v2 + q_prim_vf(i)%sf(j, k, l)**2
1970 end do
1971 if (v2 >= 1._wp) call s_mpi_abort('Error: v squared > 1 in s_convert_primitive_to_conservative_variables')
1972
1973 ga = 1._wp/sqrt(1._wp - v2)
1974
1975 h = 1._wp + (gamma + 1)*q_prim_vf(e_idx)%sf(j, k, l)/rho ! Assume perfect gas for now
1976
1977 b2 = 0._wp
1978 do i = b_idx%beg, b_idx%end
1979 b2 = b2 + q_prim_vf(i)%sf(j, k, l)**2
1980 end do
1981 if (n == 0) b2 = b2 + bx0**2
1982
1983 vdotb = 0._wp
1984 do i = 1, 3
1985 vdotb = vdotb + q_prim_vf(momxb + i - 1)%sf(j, k, l)*b(i)
1986 end do
1987
1988 do i = 1, contxe
1989 q_cons_vf(i)%sf(j, k, l) = ga*q_prim_vf(i)%sf(j, k, l)
1990 end do
1991
1992 do i = momxb, momxe
1993 q_cons_vf(i)%sf(j, k, l) = (rho*h*ga**2 + b2)*q_prim_vf(i)%sf(j, k, l) &
1994 - vdotb*b(i - momxb + 1)
1995 end do
1996
1997 q_cons_vf(e_idx)%sf(j, k, l) = rho*h*ga**2 - q_prim_vf(e_idx)%sf(j, k, l) &
1998 + 0.5_wp*(b2 + v2*b2 - vdotb**2)
1999 ! Remove rest energy
2000 do i = 1, contxe
2001 q_cons_vf(e_idx)%sf(j, k, l) = q_cons_vf(e_idx)%sf(j, k, l) - q_cons_vf(i)%sf(j, k, l)
2002 end do
2003
2004 do i = b_idx%beg, b_idx%end
2005 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
2006 end do
2007
2008 cycle ! skip all the non-relativistic conversions below
2009
2010 end if
2011
2012 ! Transferring the continuity equation(s) variable(s)
2013 do i = 1, contxe
2014 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
2015 end do
2016
2017 ! Zeroing out the dynamic pressure since it is computed
2018 ! iteratively by cycling through the velocity equations
2019 dyn_pres = 0._wp
2020
2021 ! Computing momenta and dynamic pressure from velocity
2022 do i = momxb, momxe
2023 q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l)
2024 dyn_pres = dyn_pres + q_cons_vf(i)%sf(j, k, l)* &
2025 q_prim_vf(i)%sf(j, k, l)/2._wp
2026 end do
2027
2028 if (chemistry) then
2029 do i = chemxb, chemxe
2030 ys(i - chemxb + 1) = q_prim_vf(i)%sf(j, k, l)
2031 q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l)
2032 end do
2033
2034 call get_mixture_molecular_weight(ys, mix_mol_weight)
2035 t = q_prim_vf(e_idx)%sf(j, k, l)*mix_mol_weight/(gas_constant*rho)
2036 call get_mixture_energy_mass(t, ys, e_mix)
2037
2038 q_cons_vf(e_idx)%sf(j, k, l) = &
2039 dyn_pres + rho*e_mix
2040 else
2041 ! Computing the energy from the pressure
2042 if (mhd) then
2043 if (n == 0) then
2044 pres_mag = 0.5_wp*(bx0**2 + q_prim_vf(b_idx%beg)%sf(j, k, l)**2 + q_prim_vf(b_idx%beg + 1)%sf(j, k, l)**2)
2045 else
2046 pres_mag = 0.5_wp*(q_prim_vf(b_idx%beg)%sf(j, k, l)**2 + q_prim_vf(b_idx%beg + 1)%sf(j, k, l)**2 + q_prim_vf(b_idx%beg + 2)%sf(j, k, l)**2)
2047 end if
2048 q_cons_vf(e_idx)%sf(j, k, l) = &
2049 gamma*q_prim_vf(e_idx)%sf(j, k, l) + dyn_pres + pres_mag &
2050 + pi_inf + qv
2051 elseif ((model_eqns /= 4) .and. (bubbles_euler .neqv. .true.)) then
2052 ! E = Gamma*P + \rho u u /2 + \pi_inf + (\alpha\rho qv)
2053 q_cons_vf(e_idx)%sf(j, k, l) = &
2054 gamma*q_prim_vf(e_idx)%sf(j, k, l) + dyn_pres + pi_inf + qv
2055 else if ((model_eqns /= 4) .and. (bubbles_euler)) then
2056 ! \tilde{E} = dyn_pres + (1-\alf)(\Gamma p_l + \Pi_inf)
2057 q_cons_vf(e_idx)%sf(j, k, l) = dyn_pres + &
2058 (1._wp - q_prim_vf(alf_idx)%sf(j, k, l))* &
2059 (gamma*q_prim_vf(e_idx)%sf(j, k, l) + pi_inf)
2060 else
2061 !Tait EOS, no conserved energy variable
2062 q_cons_vf(e_idx)%sf(j, k, l) = 0._wp
2063 end if
2064 end if
2065
2066 ! Computing the internal energies from the pressure and continuities
2067 if (model_eqns == 3) then
2068 do i = 1, num_fluids
2069 ! internal energy calculation for each of the fluids
2070 q_cons_vf(i + intxb - 1)%sf(j, k, l) = q_cons_vf(i + advxb - 1)%sf(j, k, l)* &
2071 (gammas(i)*q_prim_vf(e_idx)%sf(j, k, l) + pi_infs(i)) + &
2072 q_cons_vf(i + contxb - 1)%sf(j, k, l)*qvs(i)
2073 end do
2074 end if
2075
2076 if (bubbles_euler) then
2077 ! From prim: Compute nbub = (3/4pi) * \alpha / \bar{R^3}
2078 do i = 1, nb
2079 rtmp(i) = q_prim_vf(bub_idx%rs(i))%sf(j, k, l)
2080 end do
2081
2082 if (.not. qbmm) then
2083 if (adv_n) then
2084 q_cons_vf(n_idx)%sf(j, k, l) = q_prim_vf(n_idx)%sf(j, k, l)
2085 nbub = q_prim_vf(n_idx)%sf(j, k, l)
2086 else
2087 call s_comp_n_from_prim(real(q_prim_vf(alf_idx)%sf(j, k, l), kind=wp), rtmp, nbub, weight)
2088 end if
2089 else
2090 !Initialize R3 averaging over R0 and R directions
2091 r3tmp = 0._wp
2092 do i = 1, nb
2093 r3tmp = r3tmp + weight(i)*0.5_wp*(rtmp(i) + sigr)**3._wp
2094 r3tmp = r3tmp + weight(i)*0.5_wp*(rtmp(i) - sigr)**3._wp
2095 end do
2096 !Initialize nb
2097 nbub = 3._wp*q_prim_vf(alf_idx)%sf(j, k, l)/(4._wp*pi*r3tmp)
2098 end if
2099
2100 do i = bub_idx%beg, bub_idx%end
2101 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)*nbub
2102 end do
2103 end if
2104
2105 if (mhd) then
2106 do i = b_idx%beg, b_idx%end
2107 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
2108 end do
2109 end if
2110
2111 if (elasticity) then
2112 ! adding the elastic contribution
2113 ! Multiply \tau to \rho \tau
2114 do i = strxb, strxe
2115 q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l)
2116 end do
2117 end if
2118
2119 if (hypoelasticity) then
2120 if (cont_damage) g = g*max((1._wp - q_prim_vf(damage_idx)%sf(j, k, l)), 0._wp)
2121 do i = strxb, strxe
2122 ! adding elastic contribution
2123 if (g > verysmall) then
2124 q_cons_vf(e_idx)%sf(j, k, l) = q_cons_vf(e_idx)%sf(j, k, l) + &
2125 (q_prim_vf(i)%sf(j, k, l)**2._wp)/(4._wp*g)
2126 ! Double for shear stresses
2127 if (any(i == shear_indices)) then
2128 q_cons_vf(e_idx)%sf(j, k, l) = q_cons_vf(e_idx)%sf(j, k, l) + &
2129 (q_prim_vf(i)%sf(j, k, l)**2._wp)/(4._wp*g)
2130 end if
2131 end if
2132 end do
2133 end if
2134
2135 ! using \rho xi as the conservative formulation stated in Kamrin et al. JFM 2022
2136 if (hyperelasticity) then
2137 ! Multiply \xi to \rho \xi
2138 do i = xibeg, xiend
2139 q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l)
2140 end do
2141 end if
2142
2143 if (surface_tension) then
2144 q_cons_vf(c_idx)%sf(j, k, l) = q_prim_vf(c_idx)%sf(j, k, l)
2145 end if
2146
2147 if (cont_damage) q_cons_vf(damage_idx)%sf(j, k, l) = q_prim_vf(damage_idx)%sf(j, k, l)
2148
2149 if (hyper_cleaning) q_cons_vf(psi_idx)%sf(j, k, l) = q_prim_vf(psi_idx)%sf(j, k, l)
2150
2151 end do
2152 end do
2153 end do
2154#else
2155 if (proc_rank == 0) then
2156 call s_mpi_abort('Conversion from primitive to '// &
2157 'conservative variables not '// &
2158 'implemented. Exiting.')
2159 end if
2160#endif
2161 end subroutine s_convert_primitive_to_conservative_variables
2162
2163 !> The following subroutine handles the conversion between
2164 !! the primitive variables and the Eulerian flux variables.
2165 !! @param qK_prim_vf Primitive variables
2166 !! @param FK_vf Flux variables
2167 !! @param FK_src_vf Flux source variables
2168 !! @param is1 Index bounds in the first coordinate direction
2169 !! @param is2 Index bounds in the second coordinate direction
2170 !! @param is3 Index bounds in the third coordinate direction
2171 !! @param s2b Starting boundary index in the second coordinate direction
2172 !! @param s3b Starting boundary index in the third coordinate direction
2173 subroutine s_convert_primitive_to_flux_variables(qK_prim_vf, &
2174 FK_vf, &
2175 FK_src_vf, &
2176 is1, is2, is3, s2b, s3b)
2177
2178 integer, intent(in) :: s2b, s3b
2179 real(wp), dimension(0:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(in) :: qk_prim_vf
2180 real(wp), dimension(0:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(inout) :: fk_vf
2181 real(wp), dimension(0:, idwbuff(2)%beg:, idwbuff(3)%beg:, advxb:), intent(inout) :: fk_src_vf
2182
2183 type(int_bounds_info), intent(in) :: is1, is2, is3
2184
2185 ! Partial densities, density, velocity, pressure, energy, advection
2186 ! variables, the specific heat ratio and liquid stiffness functions,
2187 ! the shear and volume Reynolds numbers and the Weber numbers
2188# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2189 real(wp), dimension(num_fluids) :: alpha_rho_k
2190 real(wp), dimension(num_fluids) :: alpha_k
2191 real(wp), dimension(num_vels) :: vel_k
2192 real(wp), dimension(num_species) :: y_k
2193# 1205 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2194 real(wp) :: rho_k
2195 real(wp) :: vel_k_sum
2196 real(wp) :: pres_k
2197 real(wp) :: e_k
2198 real(wp) :: gamma_k
2199 real(wp) :: pi_inf_k
2200 real(wp) :: qv_k
2201 real(wp), dimension(2) :: re_k
2202 real(wp) :: g_k
2203 real(wp) :: t_k, mix_mol_weight, r_gas
2204
2205 integer :: i, j, k, l !< Generic loop iterators
2206
2207 is1b = is1%beg; is1e = is1%end
2208 is2b = is2%beg; is2e = is2%end
2209 is3b = is3%beg; is3e = is3%end
2210
2211
2212# 1222 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2213#if defined(MFC_OpenACC)
2214# 1222 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2215!$acc update device(is1b, is2b, is3b, is1e, is2e, is3e)
2216# 1222 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2217#elif defined(MFC_OpenMP)
2218# 1222 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2219!$omp target update to(is1b, is2b, is3b, is1e, is2e, is3e)
2220# 1222 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2221#endif
2222
2223 ! Computing the flux variables from the primitive variables, without
2224 ! accounting for the contribution of either viscosity or capillarity
2225#ifdef MFC_SIMULATION
2226
2227# 1227 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2228
2229# 1227 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2230#if defined(MFC_OpenACC)
2231# 1227 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2232!$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_K, vel_K, alpha_K, Re_K, Y_K, rho_K, vel_K_sum, pres_K, E_K, gamma_K, pi_inf_K, qv_K, G_K, T_K, mix_mol_weight, R_gas)
2233# 1227 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2234#elif defined(MFC_OpenMP)
2235# 1227 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2236
2237# 1227 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2238
2239# 1227 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2240
2241# 1227 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2242!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(alpha_rho_K, vel_K, alpha_K, Re_K, Y_K, rho_K, vel_K_sum, pres_K, E_K, gamma_K, pi_inf_K, qv_K, G_K, T_K, mix_mol_weight, R_gas)
2243# 1227 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2244#endif
2245# 1227 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2246
2247 do l = is3b, is3e
2248 do k = is2b, is2e
2249 do j = is1b, is1e
2250
2251
2252# 1232 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2253#if defined(MFC_OpenACC)
2254# 1232 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2255!$acc loop seq
2256# 1232 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2257#elif defined(MFC_OpenMP)
2258# 1232 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2259
2260# 1232 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2261#endif
2262 do i = 1, contxe
2263 alpha_rho_k(i) = qk_prim_vf(j, k, l, i)
2264 end do
2265
2266
2267# 1237 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2268#if defined(MFC_OpenACC)
2269# 1237 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2270!$acc loop seq
2271# 1237 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2272#elif defined(MFC_OpenMP)
2273# 1237 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2274
2275# 1237 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2276#endif
2277 do i = advxb, advxe
2278 alpha_k(i - e_idx) = qk_prim_vf(j, k, l, i)
2279 end do
2280
2281
2282# 1242 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2283#if defined(MFC_OpenACC)
2284# 1242 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2285!$acc loop seq
2286# 1242 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2287#elif defined(MFC_OpenMP)
2288# 1242 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2289
2290# 1242 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2291#endif
2292 do i = 1, num_vels
2293 vel_k(i) = qk_prim_vf(j, k, l, contxe + i)
2294 end do
2295
2296 vel_k_sum = 0._wp
2297
2298# 1248 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2299#if defined(MFC_OpenACC)
2300# 1248 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2301!$acc loop seq
2302# 1248 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2303#elif defined(MFC_OpenMP)
2304# 1248 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2305
2306# 1248 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2307#endif
2308 do i = 1, num_vels
2309 vel_k_sum = vel_k_sum + vel_k(i)**2._wp
2310 end do
2311
2312 pres_k = qk_prim_vf(j, k, l, e_idx)
2313 if (elasticity) then
2314 call s_convert_species_to_mixture_variables_acc(rho_k, gamma_k, pi_inf_k, qv_k, &
2315 alpha_k, alpha_rho_k, re_k, &
2316 g_k, gs_vc)
2317 else
2318 call s_convert_species_to_mixture_variables_acc(rho_k, gamma_k, pi_inf_k, qv_k, &
2319 alpha_k, alpha_rho_k, re_k)
2320 end if
2321
2322 ! Computing the energy from the pressure
2323
2324 if (chemistry) then
2325
2326# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2327#if defined(MFC_OpenACC)
2328# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2329!$acc loop seq
2330# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2331#elif defined(MFC_OpenMP)
2332# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2333
2334# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2335#endif
2336 do i = chemxb, chemxe
2337 y_k(i - chemxb + 1) = qk_prim_vf(j, k, l, i)
2338 end do
2339 !Computing the energy from the internal energy of the mixture
2340 call get_mixture_molecular_weight(y_k, mix_mol_weight)
2341 r_gas = gas_constant/mix_mol_weight
2342 t_k = pres_k/rho_k/r_gas
2343 call get_mixture_energy_mass(t_k, y_k, e_k)
2344 e_k = rho_k*e_k + 5.e-1_wp*rho_k*vel_k_sum
2345 else
2346 ! Computing the energy from the pressure
2347 e_k = gamma_k*pres_k + pi_inf_k &
2348 + 5.e-1_wp*rho_k*vel_k_sum + qv_k
2349 end if
2350
2351 ! mass flux, this should be \alpha_i \rho_i u_i
2352
2353# 1283 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2354#if defined(MFC_OpenACC)
2355# 1283 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2356!$acc loop seq
2357# 1283 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2358#elif defined(MFC_OpenMP)
2359# 1283 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2360
2361# 1283 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2362#endif
2363 do i = 1, contxe
2364 fk_vf(j, k, l, i) = alpha_rho_k(i)*vel_k(dir_idx(1))
2365 end do
2366
2367
2368# 1288 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2369#if defined(MFC_OpenACC)
2370# 1288 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2371!$acc loop seq
2372# 1288 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2373#elif defined(MFC_OpenMP)
2374# 1288 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2375
2376# 1288 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2377#endif
2378 do i = 1, num_vels
2379 fk_vf(j, k, l, contxe + dir_idx(i)) = &
2380 rho_k*vel_k(dir_idx(1)) &
2381 *vel_k(dir_idx(i)) &
2382 + pres_k*dir_flg(dir_idx(i))
2383 end do
2384
2385 ! energy flux, u(E+p)
2386 fk_vf(j, k, l, e_idx) = vel_k(dir_idx(1))*(e_k + pres_k)
2387
2388 ! Species advection Flux, \rho*u*Y
2389 if (chemistry) then
2390
2391# 1301 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2392#if defined(MFC_OpenACC)
2393# 1301 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2394!$acc loop seq
2395# 1301 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2396#elif defined(MFC_OpenMP)
2397# 1301 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2398
2399# 1301 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2400#endif
2401 do i = 1, num_species
2402 fk_vf(j, k, l, i - 1 + chemxb) = vel_k(dir_idx(1))*(rho_k*y_k(i))
2403 end do
2404 end if
2405
2406 if (riemann_solver == 1 .or. riemann_solver == 4) then
2407
2408# 1308 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2409#if defined(MFC_OpenACC)
2410# 1308 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2411!$acc loop seq
2412# 1308 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2413#elif defined(MFC_OpenMP)
2414# 1308 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2415
2416# 1308 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2417#endif
2418 do i = advxb, advxe
2419 fk_vf(j, k, l, i) = 0._wp
2420 fk_src_vf(j, k, l, i) = alpha_k(i - e_idx)
2421 end do
2422
2423 else
2424 ! Could be bubbles_euler!
2425
2426# 1316 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2427#if defined(MFC_OpenACC)
2428# 1316 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2429!$acc loop seq
2430# 1316 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2431#elif defined(MFC_OpenMP)
2432# 1316 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2433
2434# 1316 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2435#endif
2436 do i = advxb, advxe
2437 fk_vf(j, k, l, i) = vel_k(dir_idx(1))*alpha_k(i - e_idx)
2438 end do
2439
2440
2441# 1321 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2442#if defined(MFC_OpenACC)
2443# 1321 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2444!$acc loop seq
2445# 1321 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2446#elif defined(MFC_OpenMP)
2447# 1321 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2448
2449# 1321 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2450#endif
2451 do i = advxb, advxe
2452 fk_src_vf(j, k, l, i) = vel_k(dir_idx(1))
2453 end do
2454
2455 end if
2456
2457 end do
2458 end do
2459 end do
2460
2461# 1331 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2462
2463# 1331 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2464#if defined(MFC_OpenACC)
2465# 1331 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2466!$acc end parallel loop
2467# 1331 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2468#elif defined(MFC_OpenMP)
2469# 1331 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2470
2471# 1331 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2472
2473# 1331 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2474!$omp end target teams loop
2475# 1331 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2476#endif
2477# 1331 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2478
2479#endif
2480 end subroutine s_convert_primitive_to_flux_variables
2481
2482 !> This subroutine computes partial densities and volume fractions
2483 subroutine s_compute_species_fraction(q_vf, k, l, r, alpha_rho_K, alpha_K)
2484
2485# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2486#ifdef _CRAYFTN
2487# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2488#if MFC_OpenACC
2489# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2490!$acc routine seq
2491# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2492#elif MFC_OpenMP
2493# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2494
2495# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2496
2497# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2498!$omp declare target device_type(any)
2499# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2500#else
2501# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2502!DIR$ NOINLINE s_compute_species_fraction
2503# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2504#endif
2505# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2506#elif MFC_OpenACC
2507# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2508!$acc routine seq
2509# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2510#elif MFC_OpenMP
2511# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2512
2513# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2514
2515# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2516!$omp declare target device_type(any)
2517# 1337 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2518#endif
2519# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2520 type(scalar_field), dimension(sys_size), intent(in) :: q_vf
2521 integer, intent(in) :: k, l, r
2522# 1344 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2523 real(wp), dimension(num_fluids), intent(out) :: alpha_rho_k, alpha_k
2524# 1346 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2525 integer :: i
2526 real(wp) :: alpha_k_sum
2527
2528 if (num_fluids == 1) then
2529 alpha_rho_k(1) = q_vf(contxb)%sf(k, l, r)
2530 if (igr .or. bubbles_euler) then
2531 alpha_k(1) = 1._wp
2532 else
2533 alpha_k(1) = q_vf(advxb)%sf(k, l, r)
2534 end if
2535 else
2536 if (igr) then
2537 do i = 1, num_fluids - 1
2538 alpha_rho_k(i) = q_vf(i)%sf(k, l, r)
2539 alpha_k(i) = q_vf(advxb + i - 1)%sf(k, l, r)
2540 end do
2541 alpha_rho_k(num_fluids) = q_vf(num_fluids)%sf(k, l, r)
2542 alpha_k(num_fluids) = 1._wp - sum(alpha_k(1:num_fluids - 1))
2543 else
2544 do i = 1, num_fluids
2545 alpha_rho_k(i) = q_vf(i)%sf(k, l, r)
2546 alpha_k(i) = q_vf(advxb + i - 1)%sf(k, l, r)
2547 end do
2548 end if
2549 end if
2550
2551 if (mpp_lim) then
2552 alpha_k_sum = 0._wp
2553 do i = 1, num_fluids
2554 alpha_rho_k(i) = max(0._wp, alpha_rho_k(i))
2555 alpha_k(i) = min(max(0._wp, alpha_k(i)), 1._wp)
2556 alpha_k_sum = alpha_k_sum + alpha_k(i)
2557 end do
2558 alpha_k = alpha_k/max(alpha_k_sum, 1.e-16_wp)
2559 end if
2560
2561 if (num_fluids == 1 .and. bubbles_euler) alpha_k(1) = q_vf(advxb)%sf(k, l, r)
2562
2563 end subroutine s_compute_species_fraction
2564
2565 !> @brief Deallocates fluid property arrays and post-processing fields allocated during module initialization.
2566 impure subroutine s_finalize_variables_conversion_module()
2567
2568 ! Deallocating the density, the specific heat ratio function and the
2569 ! liquid stiffness function
2570#ifdef MFC_POST_PROCESS
2571 deallocate (rho_sf, gamma_sf, pi_inf_sf, qv_sf)
2572#endif
2573
2574#ifdef MFC_SIMULATION
2575#ifdef MFC_DEBUG
2576# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2577 block
2578# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2579 use iso_fortran_env, only: output_unit
2580# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2581
2582# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2583 print *, 'm_variables_conversion.fpp:1396: ', '@:DEALLOCATE(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, Gs_vc)'
2584# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2585
2586# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2587 call flush (output_unit)
2588# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2589 end block
2590# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2591#endif
2592# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2593
2594# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2595#if defined(MFC_OpenACC)
2596# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2597!$acc exit data delete(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, Gs_vc)
2598# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2599#elif defined(MFC_OpenMP)
2600# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2601!$omp target exit data map(release:gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, Gs_vc)
2602# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2603#endif
2604# 1396 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2605 deallocate (gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, gs_vc)
2606 if (bubbles_euler) then
2607#ifdef MFC_DEBUG
2608# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2609 block
2610# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2611 use iso_fortran_env, only: output_unit
2612# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2613
2614# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2615 print *, 'm_variables_conversion.fpp:1398: ', '@:DEALLOCATE(bubrs_vc)'
2616# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2617
2618# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2619 call flush (output_unit)
2620# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2621 end block
2622# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2623#endif
2624# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2625
2626# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2627#if defined(MFC_OpenACC)
2628# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2629!$acc exit data delete(bubrs_vc)
2630# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2631#elif defined(MFC_OpenMP)
2632# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2633!$omp target exit data map(release:bubrs_vc)
2634# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2635#endif
2636# 1398 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2637 deallocate (bubrs_vc)
2638 end if
2639#else
2640#ifdef MFC_DEBUG
2641# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2642 block
2643# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2644 use iso_fortran_env, only: output_unit
2645# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2646
2647# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2648 print *, 'm_variables_conversion.fpp:1401: ', '@:DEALLOCATE(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, Gs_vc)'
2649# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2650
2651# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2652 call flush (output_unit)
2653# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2654 end block
2655# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2656#endif
2657# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2658
2659# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2660#if defined(MFC_OpenACC)
2661# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2662!$acc exit data delete(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, Gs_vc)
2663# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2664#elif defined(MFC_OpenMP)
2665# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2666!$omp target exit data map(release:gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, Gs_vc)
2667# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2668#endif
2669# 1401 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2670 deallocate (gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, gs_vc)
2671 if (bubbles_euler) then
2672#ifdef MFC_DEBUG
2673# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2674 block
2675# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2676 use iso_fortran_env, only: output_unit
2677# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2678
2679# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2680 print *, 'm_variables_conversion.fpp:1403: ', '@:DEALLOCATE(bubrs_vc)'
2681# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2682
2683# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2684 call flush (output_unit)
2685# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2686 end block
2687# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2688#endif
2689# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2690
2691# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2692#if defined(MFC_OpenACC)
2693# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2694!$acc exit data delete(bubrs_vc)
2695# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2696#elif defined(MFC_OpenMP)
2697# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2698!$omp target exit data map(release:bubrs_vc)
2699# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2700#endif
2701# 1403 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2702 deallocate (bubrs_vc)
2703 end if
2704#endif
2705
2706 end subroutine s_finalize_variables_conversion_module
2707
2708#ifndef MFC_PRE_PROCESS
2709 !> @brief Computes the speed of sound from thermodynamic state variables, supporting multiple equation-of-state models.
2710 subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c_c, c, qv)
2711
2712# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2713#if MFC_OpenACC
2714# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2715!$acc routine seq
2716# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2717#elif MFC_OpenMP
2718# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2719
2720# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2721
2722# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2723!$omp declare target device_type(any)
2724# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2725#endif
2726
2727 real(wp), intent(in) :: pres
2728 real(wp), intent(in) :: rho, gamma, pi_inf, qv
2729 real(wp), intent(in) :: H
2730# 1420 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2731 real(wp), dimension(num_fluids), intent(in) :: adv
2732# 1422 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2733 real(wp), intent(in) :: vel_sum
2734 real(wp), intent(in) :: c_c
2735 real(wp), intent(out) :: c
2736
2737 real(wp) :: blkmod1, blkmod2
2738
2739 integer :: q
2740
2741 if (chemistry) then
2742 if (avg_state == 1 .and. abs(c_c) > verysmall) then
2743 c = sqrt(c_c - (gamma - 1.0_wp)*(vel_sum - h))
2744 else
2745 c = sqrt((1.0_wp + 1.0_wp/gamma)*pres/rho)
2746 end if
2747 elseif (relativity) then
2748 ! Only supports perfect gas for now
2749 c = sqrt((1._wp + 1._wp/gamma)*pres/rho/h)
2750 else
2751 if (alt_soundspeed) then
2752 blkmod1 = ((gammas(1) + 1._wp)*pres + &
2753 pi_infs(1))/gammas(1)
2754 blkmod2 = ((gammas(2) + 1._wp)*pres + &
2755 pi_infs(2))/gammas(2)
2756 c = (1._wp/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2)))
2757 elseif (model_eqns == 3) then
2758 c = 0._wp
2759
2760# 1448 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2761#if defined(MFC_OpenACC)
2762# 1448 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2763!$acc loop seq
2764# 1448 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2765#elif defined(MFC_OpenMP)
2766# 1448 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2767
2768# 1448 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2769#endif
2770 do q = 1, num_fluids
2771 c = c + adv(q)*gs_min(q)* &
2772 (pres + pi_infs(q)/(gammas(q) + 1._wp))
2773 end do
2774 c = c/rho
2775 elseif (((model_eqns == 4) .or. (model_eqns == 2 .and. bubbles_euler))) then
2776 ! Sound speed for bubble mixture to order O(\alpha)
2777
2778 if (mpp_lim .and. (num_fluids > 1)) then
2779 c = (1._wp/gamma + 1._wp)* &
2780 (pres + pi_inf/(gamma + 1._wp))/rho
2781 else
2782 c = &
2783 (1._wp/gamma + 1._wp)* &
2784 (pres + pi_inf/(gamma + 1._wp))/ &
2785 (rho*(1._wp - adv(num_fluids)))
2786 end if
2787 else
2788 c = (h - 5.e-1*vel_sum - qv/rho)/gamma
2789 end if
2790
2791 if (mixture_err .and. c < 0._wp) then
2792 c = 100._wp*sgm_eps
2793 else
2794 c = sqrt(c)
2795 end if
2796 end if
2797 end subroutine s_compute_speed_of_sound
2798#endif
2799
2800#ifndef MFC_PRE_PROCESS
2801 !> @brief Computes the fast magnetosonic wave speed from the sound speed, density, and magnetic field components.
2802 subroutine s_compute_fast_magnetosonic_speed(rho, c, B, norm, c_fast, h)
2803
2804# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2805#ifdef _CRAYFTN
2806# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2807#if MFC_OpenACC
2808# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2809!$acc routine seq
2810# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2811#elif MFC_OpenMP
2812# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2813
2814# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2815
2816# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2817!$omp declare target device_type(any)
2818# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2819#else
2820# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2821!DIR$ NOINLINE s_compute_fast_magnetosonic_speed
2822# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2823#endif
2824# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2825#elif MFC_OpenACC
2826# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2827!$acc routine seq
2828# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2829#elif MFC_OpenMP
2830# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2831
2832# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2833
2834# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2835!$omp declare target device_type(any)
2836# 1482 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2837#endif
2838# 1484 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2839
2840 real(wp), intent(in) :: B(3), rho, c
2841 real(wp), intent(in) :: h ! only used for relativity
2842 real(wp), intent(out) :: c_fast
2843 integer, intent(in) :: norm
2844
2845 real(wp) :: B2, term, disc
2846
2847 b2 = sum(b**2)
2848
2849 if (.not. relativity) then
2850 term = c**2 + b2/rho
2851 disc = term**2 - 4*c**2*(b(norm)**2/rho)
2852 else
2853 ! Note: this is approximation for the non-relatisitic limit; accurate solution requires solving a quartic equation
2854 term = (c**2*(b(norm)**2 + rho*h) + b2)/(rho*h + b2)
2855 disc = term**2 - 4*c**2*b(norm)**2/(rho*h + b2)
2856 end if
2857
2858#ifdef DEBUG
2859 if (disc < 0._wp) then
2860 print *, 'rho, c, Bx, By, Bz, h, term, disc:', rho, c, b(1), b(2), b(3), h, term, disc
2861 call s_mpi_abort('Error: negative discriminant in s_compute_fast_magnetosonic_speed')
2862 end if
2863#endif
2864
2865 c_fast = sqrt(0.5_wp*(term + sqrt(disc)))
2866
2867 end subroutine s_compute_fast_magnetosonic_speed
2868#endif
2869
2870end module m_variables_conversion
q_cons_vf
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
Definition m_phase_change.fpp.f90:1180
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1182
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1182
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1182
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:294
m_global_parameters
Global parameters for the post-process: domain geometry, equation of state, and output database setti...
Definition m_global_parameters.fpp.f90:19
m_global_parameters::bubbles_euler
logical bubbles_euler
Definition m_global_parameters.fpp.f90:324
m_global_parameters::g
real(wp) g
Definition m_global_parameters.fpp.f90:336
m_global_parameters::hypoelasticity
logical hypoelasticity
Turn hypoelasticity on.
Definition m_global_parameters.fpp.f90:123
m_global_parameters::rhoref
real(wp) rhoref
Definition m_global_parameters.fpp.f90:315
m_global_parameters::num_fluids
integer num_fluids
Number of different fluids present in the flow.
Definition m_global_parameters.fpp.f90:111
m_global_parameters::stress_idx
type(int_bounds_info) stress_idx
Indices of elastic stresses.
Definition m_global_parameters.fpp.f90:151
m_global_parameters::gamma_idx
integer gamma_idx
Index of specific heat ratio func. eqn.
Definition m_global_parameters.fpp.f90:147
m_global_parameters::model_eqns
integer model_eqns
Multicomponent flow model.
Definition m_global_parameters.fpp.f90:110
m_global_parameters::fluid_pp
type(physical_parameters), dimension(num_fluids_max) fluid_pp
Database of the physical parameters of each of the fluids that is present in the flow....
Definition m_global_parameters.fpp.f90:212
m_global_parameters::pi_inf_idx
integer pi_inf_idx
Index of liquid stiffness func. eqn.
Definition m_global_parameters.fpp.f90:149
m_global_parameters::pref
real(wp) pref
Definition m_global_parameters.fpp.f90:315
m_global_parameters::mhd
logical mhd
Magnetohydrodynamics.
Definition m_global_parameters.fpp.f90:121
m_global_parameters::shear_indices
integer, dimension(3) shear_indices
Indices of the stress components that represent shear stress.
Definition m_global_parameters.fpp.f90:176
m_global_parameters::mpp_lim
logical mpp_lim
Maximum volume fraction limiter.
Definition m_global_parameters.fpp.f90:114
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:294
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:305
m_mpi_proxy
MPI gather and scatter operations for distributing post-process grid and flow-variable data.
Definition m_mpi_proxy.fpp.f90:7
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:305
m_variables_conversion::s_compute_fast_magnetosonic_speed
subroutine s_compute_fast_magnetosonic_speed(rho, c, b, norm, c_fast, h)
Computes the fast magnetosonic wave speed from the sound speed, density, and magnetic field component...
Definition m_variables_conversion.fpp.f90:2803
m_variables_conversion::s_convert_primitive_to_flux_variables
subroutine, public s_convert_primitive_to_flux_variables(qk_prim_vf, fk_vf, fk_src_vf, is1, is2, is3, s2b, s3b)
The following subroutine handles the conversion between the primitive variables and the Eulerian flux...
Definition m_variables_conversion.fpp.f90:2177
m_variables_conversion::gammas
real(wp), dimension(:), allocatable, public gammas
Definition m_variables_conversion.fpp.f90:344
m_variables_conversion::pi_inf_sf
real(wp), dimension(:, :, :), allocatable, public pi_inf_sf
Scalar liquid stiffness function.
Definition m_variables_conversion.fpp.f90:388
m_variables_conversion::ps_inf
real(wp), dimension(:), allocatable, public ps_inf
Definition m_variables_conversion.fpp.f90:344
m_variables_conversion::s_compute_species_fraction
subroutine, public s_compute_species_fraction(q_vf, k, l, r, alpha_rho_k, alpha_k)
This subroutine computes partial densities and volume fractions.
Definition m_variables_conversion.fpp.f90:2484
m_variables_conversion::s_compute_speed_of_sound
subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, h, adv, vel_sum, c_c, c, qv)
Computes the speed of sound from thermodynamic state variables, supporting multiple equation-of-state...
Definition m_variables_conversion.fpp.f90:2711
m_variables_conversion::gs_min
real(wp), dimension(:), allocatable, public gs_min
Definition m_variables_conversion.fpp.f90:344
m_variables_conversion::qvs
real(wp), dimension(:), allocatable, public qvs
Definition m_variables_conversion.fpp.f90:344
m_variables_conversion::is3e
integer is3e
Definition m_variables_conversion.fpp.f90:373
m_variables_conversion::res_vc
real(wp), dimension(:, :), allocatable res_vc
Definition m_variables_conversion.fpp.f90:360
m_variables_conversion::s_initialize_mv
subroutine, public s_initialize_mv(qk_cons_vf, mv)
Initializes bubble mass-vapor values at quadrature nodes from the conserved moment statistics.
Definition m_variables_conversion.fpp.f90:1257
m_variables_conversion::s_initialize_pb
subroutine, public s_initialize_pb(qk_cons_vf, mv, pb)
Initializes bubble internal pressures at quadrature nodes using isothermal relations from the Preston...
Definition m_variables_conversion.fpp.f90:1300
m_variables_conversion::rho_sf
real(wp), dimension(:, :, :), allocatable, public rho_sf
Scalar density function.
Definition m_variables_conversion.fpp.f90:386
m_variables_conversion::cvs
real(wp), dimension(:), allocatable, public cvs
Definition m_variables_conversion.fpp.f90:344
m_variables_conversion::s_compute_pressure
subroutine, public s_compute_pressure(energy, alf, dyn_p, pi_inf, gamma, rho, qv, rhoyks, pres, t, stress, mom, g, pres_mag)
This procedure conditionally calculates the appropriate pressure.
Definition m_variables_conversion.fpp.f90:444
m_variables_conversion::qv_sf
real(wp), dimension(:, :, :), allocatable, public qv_sf
Scalar liquid energy reference function.
Definition m_variables_conversion.fpp.f90:389
m_variables_conversion::s_convert_primitive_to_conservative_variables
impure subroutine, public s_convert_primitive_to_conservative_variables(q_prim_vf, q_cons_vf)
The following procedure handles the conversion between the primitive variables and the conservative v...
Definition m_variables_conversion.fpp.f90:1903
m_variables_conversion::is3b
integer is3b
Definition m_variables_conversion.fpp.f90:373
m_variables_conversion::qvps
real(wp), dimension(:), allocatable, public qvps
Definition m_variables_conversion.fpp.f90:344
m_variables_conversion::s_convert_conservative_to_primitive_variables
subroutine, public s_convert_conservative_to_primitive_variables(qk_cons_vf, q_t_sf, qk_prim_vf, ibounds)
The following procedure handles the conversion between the conservative variables and the primitive v...
Definition m_variables_conversion.fpp.f90:1351
m_variables_conversion::s_initialize_variables_conversion_module
impure subroutine, public s_initialize_variables_conversion_module
The computation of parameters, the allocation of memory, the association of pointers and/or the execu...
Definition m_variables_conversion.fpp.f90:786
m_variables_conversion::s_convert_species_to_mixture_variables
subroutine, public s_convert_species_to_mixture_variables(q_vf, k, l, r, rho, gamma, pi_inf, qv, re_k, g_k, g)
This subroutine is designed for the volume fraction model and provided a set of either conservative o...
Definition m_variables_conversion.fpp.f90:599
m_variables_conversion::s_convert_mixture_to_mixture_variables
subroutine, public s_convert_mixture_to_mixture_variables(q_vf, i, j, k, rho, gamma, pi_inf, qv)
This subroutine is designed for the gamma/pi_inf model and provided a set of either conservative or p...
Definition m_variables_conversion.fpp.f90:555
m_variables_conversion::is2e
integer is2e
Definition m_variables_conversion.fpp.f90:373
m_variables_conversion::gamma_sf
real(wp), dimension(:, :, :), allocatable, public gamma_sf
Scalar sp. heat ratio function.
Definition m_variables_conversion.fpp.f90:387
m_variables_conversion::is1b
integer is1b
Definition m_variables_conversion.fpp.f90:373
m_variables_conversion::pi_infs
real(wp), dimension(:), allocatable, public pi_infs
Definition m_variables_conversion.fpp.f90:344
m_variables_conversion::bubrs_vc
integer, dimension(:), allocatable bubrs_vc
Definition m_variables_conversion.fpp.f90:359
m_variables_conversion::gs_vc
real(wp), dimension(:), allocatable gs_vc
Definition m_variables_conversion.fpp.f90:358
m_variables_conversion::is1e
integer is1e
Definition m_variables_conversion.fpp.f90:373
m_variables_conversion::s_finalize_variables_conversion_module
impure subroutine s_finalize_variables_conversion_module()
Deallocates fluid property arrays and post-processing fields allocated during module initialization.
Definition m_variables_conversion.fpp.f90:2567
m_variables_conversion::s_convert_to_mixture_variables
subroutine, public s_convert_to_mixture_variables(q_vf, i, j, k, rho, gamma, pi_inf, qv, re_k, g_k, g)
Dispatch to the s_convert_mixture_to_mixture_variables and s_convert_species_to_mixture_variables sub...
Definition m_variables_conversion.fpp.f90:409
m_variables_conversion::is2b
integer is2b
Definition m_variables_conversion.fpp.f90:373
m_variables_conversion::s_convert_species_to_mixture_variables_acc
subroutine, public s_convert_species_to_mixture_variables_acc(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, alpha_rho_k, re_k, g_k, g)
GPU-accelerated conversion of species volume fractions and partial densities to mixture density,...
Definition m_variables_conversion.fpp.f90:677
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:309