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