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