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
33# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
34! New line at end of file is required for FYPP
35# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
36# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
37# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
38# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
40# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
42# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
46# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
47
48# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
49
50# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51
52# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53
54# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
55
56# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57
58# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
59
60# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
61
62# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
63! New line at end of file is required for FYPP
64# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
65
66# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
67# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
68# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
69# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
70# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
71
72# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
73
74# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
75
76# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77
78# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79
80# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
81
82# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
83
84# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
85
86# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 126 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 156 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 197 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 211 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 236 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 247 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 249 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117# 260 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 310 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 320 "/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# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 356 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 366 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 373 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 379 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 385 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 391 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 397 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 403 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
142! New line at end of file is required for FYPP
143# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
144# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
145# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
146# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
147# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
148# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
149# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
150# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
151
152# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
153# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
154# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
155
156# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157
158# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159
160# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
161
162# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163
164# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
165
166# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
167
168# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
169
170# 167 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
171! New line at end of file is required for FYPP
172# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
173
174# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
175
176# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
177
178# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
179
180# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
181
182# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
183
184# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
185
186# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
187
188# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
189
190# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
191
192# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
193
194# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
195
196# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
197
198# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
199
200# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
201
202# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
203
204# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
205
206# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
207
208# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
209
210# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
211
212# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
213
214# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
215
216# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
217
218# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
219
220# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
221
222# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
223
224# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
225
226# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
227
228# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
229! New line at end of file is required for FYPP
230# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
231
232! GPU parallel region (scalar reductions, maxval/minval)
233# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
234
235! GPU parallel loop over threads (most common GPU macro)
236# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
237
238! Required closing for GPU_PARALLEL_LOOP
239# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
240
241! Mark routine for device compilation
242# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
243
244! Declare device-resident data
245# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247! Inner loop within a GPU parallel region
248# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
249
250! Scoped GPU data region
251# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253! Host code with device pointers (for MPI with GPU buffers)
254# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
255
256! Allocate device memory (unscoped)
257# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259! Free device memory
260# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
261
262! Atomic operation on device
263# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265! End atomic capture block
266# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
267
268! Copy data between host and device
269# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271! Synchronization barrier
272# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
273
274! Import GPU library module (openacc or omp_lib)
275# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276
277! Emit code only for AMD compiler
278# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
279
280! Emit code for non-Cray compilers
281# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
282
283! Emit code only for Cray compiler
284# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
285
286! Emit code for non-NVIDIA compilers
287# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
288
289# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
290# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
291! New line at end of file is required for FYPP
292# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
293
294# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
295
296! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
297! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
298! example see misc/nvidia_uvm/bind.sh.
299# 52 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
300
301! Allocate and create GPU device memory
302# 72 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
303
304! Free GPU device memory and deallocate
305# 80 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
306
307! Cray-specific GPU pointer setup for vector fields
308# 104 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
309
310! Cray-specific GPU pointer setup for scalar fields
311# 120 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
312
313! Cray-specific GPU pointer setup for acoustic source spatials
314# 145 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
315
316# 151 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
317
318# 158 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
319! New line at end of file is required for FYPP
320# 6 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp" 2
321# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
322! This file exists so that Fypp can be run without generating case.fpp files for
323! each target. This is useful when generating documentation, for example. This
324! should also let MFC be built with CMake directly, without invoking mfc.sh.
325
326! For pre-process.
327# 8 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
328
329! For moving immersed boundaries in simulation
330# 12 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
331# 7 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp" 2
332
333!> @brief Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation
334module m_variables_conversion
335
336 use m_derived_types
337 use m_global_parameters
338 use m_mpi_proxy
339 use m_helper_basic
340 use m_helper
341 use m_constants, only: riemann_solver_hll, riemann_solver_hlld, model_eqns_gamma_law, model_eqns_5eq, model_eqns_6eq, &
342 & avg_state_roe
343 use m_thermochem, only: num_species, get_temperature, get_pressure, gas_constant, get_mixture_molecular_weight, &
344 & get_mixture_energy_mass
345
346 implicit none
347
348 private
349 public :: s_initialize_variables_conversion_module, s_initialize_pb, s_initialize_mv, s_convert_to_mixture_variables, &
350 & s_convert_mixture_to_mixture_variables, s_convert_species_to_mixture_variables, &
351 & s_convert_species_to_mixture_variables_kernel, s_convert_conservative_to_primitive_variables, &
352 & s_convert_primitive_to_conservative_variables, s_convert_primitive_to_flux_variables, s_compute_pressure, &
353 & s_compute_species_fraction, s_compute_mixture_coefficients, s_compute_energy, s_compute_speed_of_sound, f_bulk_modulus, &
354 & f_pressure, f_phase_internal_energy, f_isentrope_exponent, f_isentrope_pressure, f_sg_thermal, f_pressure_on_isentrope, &
355 & s_compute_mixture_coefficients_dt, s_compute_speed_of_sound_avg, s_compute_fast_magnetosonic_speed, f_elastic_energy, &
356 & f_hypoelastic_energy, f_relativistic_enthalpy, s_finalize_variables_conversion_module, gammas, isentrope_n, pi_infs, &
357 & isentrope_b, cvs, qvs, qvps
358
359 real(wp), allocatable, dimension(:) :: gs_vc
360 integer, allocatable, dimension(:) :: bubrs_vc
361 real(wp), allocatable, dimension(:,:) :: res_vc
362
363# 37 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
364#if defined(MFC_OpenACC)
365# 37 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
366!$acc declare create(bubrs_vc, Gs_vc, Res_vc)
367# 37 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
368#elif defined(MFC_OpenMP)
369# 37 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
370!$omp declare target (bubrs_vc, Gs_vc, Res_vc)
371# 37 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
372#endif
373
374 integer :: is1b, is2b, is3b, is1e, is2e, is3e
375
376# 40 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
377#if defined(MFC_OpenACC)
378# 40 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
379!$acc declare create(is1b, is2b, is3b, is1e, is2e, is3e)
380# 40 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
381#elif defined(MFC_OpenMP)
382# 40 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
383!$omp declare target (is1b, is2b, is3b, is1e, is2e, is3e)
384# 40 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
385#endif
386
387 logical :: enforce_density_floor_vc = .false.
388 logical :: preserve_qbmm_number_vc = .false.
389 integer :: lagrange_beta_index_vc = 0
390
391# 45 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
392#if defined(MFC_OpenACC)
393# 45 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
394!$acc declare create(enforce_density_floor_vc, preserve_qbmm_number_vc, lagrange_beta_index_vc)
395# 45 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
396#elif defined(MFC_OpenMP)
397# 45 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
398!$omp declare target (enforce_density_floor_vc, preserve_qbmm_number_vc, lagrange_beta_index_vc)
399# 45 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
400#endif
401
402 real(wp), allocatable, dimension(:,:,:), public :: rho_sf !< Scalar density function
403 real(wp), allocatable, dimension(:,:,:), public :: gamma_sf !< Scalar sp. heat ratio function
404 real(wp), allocatable, dimension(:,:,:), public :: pi_inf_sf !< Scalar liquid stiffness function
405
406contains
407
408 !> Dispatch to the s_convert_mixture_to_mixture_variables and s_convert_species_to_mixture_variables subroutines. Replaces a
409 !! procedure pointer.
410 subroutine s_convert_to_mixture_variables(q_vf, i, j, k, rho, gamma, pi_inf, qv, Re_K, G_K, G)
411
412 type(scalar_field), dimension(sys_size), intent(in) :: q_vf
413 integer, intent(in) :: i, j, k
414 real(wp), intent(out), target :: rho, gamma, pi_inf, qv
415 real(wp), optional, dimension(2), intent(out) :: re_k
416 real(wp), optional, intent(out) :: g_k
417 real(wp), optional, dimension(num_fluids), intent(in) :: g
418
419 if (model_eqns == model_eqns_gamma_law) then ! Gamma/pi_inf model
420 call s_convert_mixture_to_mixture_variables(q_vf, i, j, k, rho, gamma, pi_inf, qv)
421 else ! Volume fraction model
422 call s_convert_species_to_mixture_variables(q_vf, i, j, k, rho, gamma, pi_inf, qv, re_k, g_k, g)
423 end if
424
425 end subroutine s_convert_to_mixture_variables
426
427 !> Compute the pressure from the appropriate equation of state
428 subroutine s_compute_pressure(energy, alf, dyn_p, pi_inf, gamma, rho, qv, rhoYks, pres, T, E_e_in, pres_mag)
429
430
431# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
432#ifdef _CRAYFTN
433# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
434#if MFC_OpenACC
435# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
436!$acc routine seq
437# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
438#elif MFC_OpenMP
439# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
440
441# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
442
443# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
444!$omp declare target device_type(any)
445# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
446#else
447# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
448!DIR$ NOINLINE s_compute_pressure
449# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
450#endif
451# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
452#elif MFC_OpenACC
453# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
454!$acc routine seq
455# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
456#elif MFC_OpenMP
457# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
458
459# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
460
461# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
462!$omp declare target device_type(any)
463# 75 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
464#endif
465
466 real(stp), intent(in) :: energy, alf
467 real(wp), intent(in) :: dyn_p
468 real(wp), intent(in) :: pi_inf, gamma, rho, qv
469 real(wp), intent(out) :: pres
470 real(wp), intent(inout) :: t
471 real(wp), intent(in), optional :: e_e_in, pres_mag
472
473 ! Chemistry
474 real(wp), dimension(1:num_species), intent(in) :: rhoyks
475 real(wp), dimension(1:num_species) :: y_rs
476 real(wp) :: e_int
477 real(wp) :: e_per_kg, pdyn_per_kg
478 real(wp) :: t_guess
479# 91 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
480 ! What is the internal energy? The magnetic, elastic and kinetic parts are model
481 ! bookkeeping rather than equation of state, so they come off here and the inversion runs once.
482 if (mhd) then
483 ! MHD: the magnetic energy is not an equation-of-state term
484 e_int = energy - dyn_p - pres_mag
485 else if (bubbles_euler .neqv. .true.) then
486 ! Gamma/pi_inf model or five-equation model (Allaire et al. JCP 2002)
487 e_int = energy - dyn_p
488 else
489 ! Bubble-augmented; qv comes off before the division rather than being scaled by it
490 e_int = (energy - dyn_p - qv)/(1._wp - alf) + qv
491 end if
492
493 if (hypoelasticity .and. present(e_e_in)) then
494 ! Subtract elastic strain energy before computing pressure (hypoelastic model)
495 e_int = energy - dyn_p - e_e_in
496 end if
497
498 pres = f_pressure(e_int, gamma, pi_inf, qv)
499# 121 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
500
501 end subroutine s_compute_pressure
502
503 !> Convert mixture variables to density, gamma, pi_inf, and qv for the gamma/pi_inf model. Given conservative or primitive
504 !! variables, transfers the density, specific heat ratio function and the liquid stiffness function from q_vf to rho, gamma and
505 !! pi_inf.
506 subroutine s_convert_mixture_to_mixture_variables(q_vf, i, j, k, rho, gamma, pi_inf, qv)
507
508 type(scalar_field), dimension(sys_size), intent(in) :: q_vf
509 integer, intent(in) :: i, j, k
510 real(wp), intent(out), target :: rho
511 real(wp), intent(out), target :: gamma
512 real(wp), intent(out), target :: pi_inf
513 real(wp), intent(out), target :: qv
514
515 ! Transferring the density, the specific heat ratio function and the liquid stiffness function, respectively
516
517 rho = q_vf(1)%sf(i, j, k)
518 gamma = q_vf(eqn_idx%gamma)%sf(i, j, k)
519 pi_inf = q_vf(eqn_idx%pi_inf)%sf(i, j, k)
520 qv = 0._wp ! keep this value nil for now. For future adjustment
521
522 ! Store derived mixture fields when requested during module initialization.
523 if (allocated(rho_sf)) then
524 rho_sf(i, j, k) = rho
525 gamma_sf(i, j, k) = gamma
526 pi_inf_sf(i, j, k) = pi_inf
527 end if
528
529 end subroutine s_convert_mixture_to_mixture_variables
530
531 !> Convert species volume fractions and partial densities to mixture density, gamma, pi_inf, and qv. Given conservative or
532 !! primitive variables, computes the density, the specific heat ratio function and the liquid stiffness function from q_vf and
533 !! stores the results into rho, gamma and pi_inf.
534 subroutine s_convert_species_to_mixture_variables(q_vf, k, l, r, rho, gamma, pi_inf, qv, Re_K, G_K, G)
535
536 type(scalar_field), dimension(sys_size), intent(in) :: q_vf
537 integer, intent(in) :: k, l, r
538 real(wp), intent(out), target :: rho
539 real(wp), intent(out), target :: gamma
540 real(wp), intent(out), target :: pi_inf
541 real(wp), intent(out), target :: qv
542 real(wp), optional, dimension(2), intent(out) :: re_k
543 real(wp), optional, intent(out) :: g_k
544 real(wp), dimension(num_fluids) :: alpha_rho_k, alpha_k
545 real(wp), optional, dimension(num_fluids), intent(in) :: g
546 integer :: i, j !< Generic loop iterator
547 ! Computing the density, the specific heat ratio function and the liquid stiffness function, respectively
548
549 call s_compute_species_fraction(q_vf, k, l, r, alpha_rho_k, alpha_k)
550
551 ! Use the same scalar kernel on host and device so mixture semantics do not depend on the executable or accelerator backend.
552 ! Absent optional dummies forward as absent, so the optional arguments need no dispatch here.
553 call s_convert_species_to_mixture_variables_kernel(rho, gamma, pi_inf, qv, alpha_k, alpha_rho_k, re_k, g_k, g)
554
555 ! Store derived mixture fields when requested during module initialization.
556 if (allocated(rho_sf)) then
557 rho_sf(k, l, r) = rho
558 gamma_sf(k, l, r) = gamma
559 pi_inf_sf(k, l, r) = pi_inf
560 end if
561
562 end subroutine s_convert_species_to_mixture_variables
563
564 !> Host- and device-callable conversion kernel for species and mixture variables.
565 subroutine s_convert_species_to_mixture_variables_kernel(rho_K, gamma_K, pi_inf_K, qv_K, alpha_K, alpha_rho_K, Re_K, G_K, G)
566
567
568# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
569#ifdef _CRAYFTN
570# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
571#if MFC_OpenACC
572# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
573!$acc routine seq
574# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
575#elif MFC_OpenMP
576# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
577
578# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
579
580# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
581!$omp declare target device_type(any)
582# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
583#else
584# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
585!DIR$ NOINLINE s_convert_species_to_mixture_variables_kernel
586# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
587#endif
588# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
589#elif MFC_OpenACC
590# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
591!$acc routine seq
592# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
593#elif MFC_OpenMP
594# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
595
596# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
597
598# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
599!$omp declare target device_type(any)
600# 188 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
601#endif
602
603 real(wp), intent(out) :: rho_k, gamma_k, pi_inf_k, qv_k
604# 195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
605 real(wp), dimension(num_fluids), intent(inout) :: alpha_rho_k, alpha_k
606 real(wp), optional, dimension(num_fluids), intent(in) :: g
607# 198 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
608 real(wp), optional, dimension(2), intent(out) :: re_k
609 real(wp), optional, intent(out) :: g_k
610 real(wp) :: alpha_k_sum
611 integer :: i, j !< Generic loop iterators
612
613 rho_k = 0._wp
614 gamma_k = 0._wp
615 pi_inf_k = 0._wp
616 qv_k = 0._wp
617 if (present(re_k)) re_k = dflt_real
618 if (present(g_k)) g_k = 0._wp
619
620 ! Constrain partial densities and volume fractions within physical bounds
621 if (mpp_lim) then
622 alpha_k_sum = 0._wp
623 do i = 1, num_fluids
624 alpha_rho_k(i) = max(0._wp, alpha_rho_k(i))
625 alpha_k(i) = min(max(0._wp, alpha_k(i)), 1._wp)
626 alpha_k_sum = alpha_k_sum + alpha_k(i)
627 end do
628 alpha_k = alpha_k/max(alpha_k_sum, sgm_eps)
629 end if
630 call s_compute_mixture_coefficients(alpha_rho_k, alpha_k, rho_k, gamma_k, pi_inf_k, qv_k)
631
632 if (present(g_k)) then
633 g_k = 0._wp
634 do i = 1, num_fluids
635 ! TODO: change to use Gs_vc directly here? TODO: Make this change as well for GPUs
636 g_k = g_k + alpha_k(i)*g(i)
637 end do
638 g_k = max(0._wp, g_k)
639 end if
640
641 if (viscous .and. present(re_k)) then
642 do i = 1, 2
643 re_k(i) = dflt_real
644
645 if (re_size(i) > 0) re_k(i) = 0._wp
646
647 do j = 1, re_size(i)
648 re_k(i) = alpha_k(re_idx(i, j))/res_vc(i, j) + re_k(i)
649 end do
650
651 re_k(i) = 1._wp/max(re_k(i), sgm_eps)
652 end do
653 end if
654
655 end subroutine s_convert_species_to_mixture_variables_kernel
656
657 !> Initialize the variables conversion module.
658 impure subroutine s_initialize_variables_conversion_module(store_mixture_fields, enforce_density_floor, preserve_qbmm_number, &
659 & lagrange_beta_index)
660
661 integer :: i, j
662 logical, optional, intent(in) :: store_mixture_fields
663 logical, optional, intent(in) :: enforce_density_floor, preserve_qbmm_number
664 integer, optional, intent(in) :: lagrange_beta_index
665 logical :: allocate_mixture_fields
666
667 allocate_mixture_fields = .false.
668 if (present(store_mixture_fields)) allocate_mixture_fields = store_mixture_fields
669 enforce_density_floor_vc = .false.
670 if (present(enforce_density_floor)) enforce_density_floor_vc = enforce_density_floor
671 preserve_qbmm_number_vc = .false.
672 if (present(preserve_qbmm_number)) preserve_qbmm_number_vc = preserve_qbmm_number
673 lagrange_beta_index_vc = 0
674 if (present(lagrange_beta_index)) lagrange_beta_index_vc = lagrange_beta_index
675
676
677# 266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
678#if defined(MFC_OpenACC)
679# 266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
680!$acc enter data copyin(is1b, is1e, is2b, is2e, is3b, is3e)
681# 266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
682#elif defined(MFC_OpenMP)
683# 266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
684!$omp target enter data map(to:is1b, is1e, is2b, is2e, is3b, is3e)
685# 266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
686#endif
687
688# 267 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
689#if defined(MFC_OpenACC)
690# 267 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
691!$acc update device(enforce_density_floor_vc, preserve_qbmm_number_vc, lagrange_beta_index_vc)
692# 267 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
693#elif defined(MFC_OpenMP)
694# 267 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
695!$omp target update to(enforce_density_floor_vc, preserve_qbmm_number_vc, lagrange_beta_index_vc)
696# 267 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
697#endif
698
699#ifdef MFC_DEBUG
700# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
701 block
702# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
703 use iso_fortran_env, only: output_unit
704# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
705
706# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
707 print *, 'm_variables_conversion.fpp:269: ', '@:ALLOCATE(gammas (1:num_fluids))'
708# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
709
710# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
711 call flush (output_unit)
712# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
713 end block
714# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
715#endif
716# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
717 allocate (gammas(1:num_fluids))
718# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
719
720# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
721
722# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
723#if defined(MFC_OpenACC)
724# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
725!$acc enter data create(gammas)
726# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
727#elif defined(MFC_OpenMP)
728# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
729!$omp target enter data map(always,alloc:gammas)
730# 269 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
731#endif
732#ifdef MFC_DEBUG
733# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
734 block
735# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
736 use iso_fortran_env, only: output_unit
737# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
738
739# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
740 print *, 'm_variables_conversion.fpp:270: ', '@:ALLOCATE(isentrope_n (1:num_fluids))'
741# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
742
743# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
744 call flush (output_unit)
745# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
746 end block
747# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
748#endif
749# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
750 allocate (isentrope_n(1:num_fluids))
751# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
752
753# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
754
755# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
756#if defined(MFC_OpenACC)
757# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
758!$acc enter data create(isentrope_n)
759# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
760#elif defined(MFC_OpenMP)
761# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
762!$omp target enter data map(always,alloc:isentrope_n)
763# 270 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
764#endif
765#ifdef MFC_DEBUG
766# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
767 block
768# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
769 use iso_fortran_env, only: output_unit
770# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
771
772# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
773 print *, 'm_variables_conversion.fpp:271: ', '@:ALLOCATE(pi_infs(1:num_fluids))'
774# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
775
776# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
777 call flush (output_unit)
778# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
779 end block
780# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
781#endif
782# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
783 allocate (pi_infs(1:num_fluids))
784# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
785
786# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
787
788# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
789#if defined(MFC_OpenACC)
790# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
791!$acc enter data create(pi_infs)
792# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
793#elif defined(MFC_OpenMP)
794# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
795!$omp target enter data map(always,alloc:pi_infs)
796# 271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
797#endif
798#ifdef MFC_DEBUG
799# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
800 block
801# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
802 use iso_fortran_env, only: output_unit
803# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
804
805# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
806 print *, 'm_variables_conversion.fpp:272: ', '@:ALLOCATE(isentrope_B(1:num_fluids))'
807# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
808
809# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
810 call flush (output_unit)
811# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
812 end block
813# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
814#endif
815# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
816 allocate (isentrope_b(1:num_fluids))
817# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
818
819# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
820
821# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
822#if defined(MFC_OpenACC)
823# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
824!$acc enter data create(isentrope_B)
825# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
826#elif defined(MFC_OpenMP)
827# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
828!$omp target enter data map(always,alloc:isentrope_B)
829# 272 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
830#endif
831#ifdef MFC_DEBUG
832# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
833 block
834# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
835 use iso_fortran_env, only: output_unit
836# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
837
838# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
839 print *, 'm_variables_conversion.fpp:273: ', '@:ALLOCATE(cvs (1:num_fluids))'
840# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
841
842# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
843 call flush (output_unit)
844# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
845 end block
846# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
847#endif
848# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
849 allocate (cvs(1:num_fluids))
850# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
851
852# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
853
854# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
855#if defined(MFC_OpenACC)
856# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
857!$acc enter data create(cvs)
858# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
859#elif defined(MFC_OpenMP)
860# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
861!$omp target enter data map(always,alloc:cvs)
862# 273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
863#endif
864#ifdef MFC_DEBUG
865# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
866 block
867# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
868 use iso_fortran_env, only: output_unit
869# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
870
871# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
872 print *, 'm_variables_conversion.fpp:274: ', '@:ALLOCATE(qvs (1:num_fluids))'
873# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
874
875# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
876 call flush (output_unit)
877# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
878 end block
879# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
880#endif
881# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
882 allocate (qvs(1:num_fluids))
883# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
884
885# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
886
887# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
888#if defined(MFC_OpenACC)
889# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
890!$acc enter data create(qvs)
891# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
892#elif defined(MFC_OpenMP)
893# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
894!$omp target enter data map(always,alloc:qvs)
895# 274 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
896#endif
897#ifdef MFC_DEBUG
898# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
899 block
900# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
901 use iso_fortran_env, only: output_unit
902# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
903
904# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
905 print *, 'm_variables_conversion.fpp:275: ', '@:ALLOCATE(qvps (1:num_fluids))'
906# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
907
908# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
909 call flush (output_unit)
910# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
911 end block
912# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
913#endif
914# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
915 allocate (qvps(1:num_fluids))
916# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
917
918# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
919
920# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
921#if defined(MFC_OpenACC)
922# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
923!$acc enter data create(qvps)
924# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
925#elif defined(MFC_OpenMP)
926# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
927!$omp target enter data map(always,alloc:qvps)
928# 275 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
929#endif
930#ifdef MFC_DEBUG
931# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
932 block
933# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
934 use iso_fortran_env, only: output_unit
935# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
936
937# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
938 print *, 'm_variables_conversion.fpp:276: ', '@:ALLOCATE(Gs_vc (1:num_fluids))'
939# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
940
941# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
942 call flush (output_unit)
943# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
944 end block
945# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
946#endif
947# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
948 allocate (gs_vc(1:num_fluids))
949# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
950
951# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
952
953# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
954#if defined(MFC_OpenACC)
955# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
956!$acc enter data create(Gs_vc)
957# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
958#elif defined(MFC_OpenMP)
959# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
960!$omp target enter data map(always,alloc:Gs_vc)
961# 276 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
962#endif
963
964 do i = 1, num_fluids
965 gammas(i) = fluid_pp(i)%gamma
966 isentrope_n(i) = f_isentrope_exponent(gammas(i))
967
968 ! Each EOS supplies its own coefficients. Resolved once here, not per cell: a branch in the mixture loop costs
969 ! registers in the Riemann kernels. An EOS whose coefficients depend on state must move to per-cell evaluation.
970 select case (fluid_pp(i)%eos)
971 case (eos_ideal_gas)
972 pi_infs(i) = 0._wp
973 case default
974 pi_infs(i) = fluid_pp(i)%pi_inf
975 end select
976 gs_vc(i) = fluid_pp(i)%G
977 isentrope_b(i) = f_isentrope_pressure(pi_infs(i), gammas(i))
978 cvs(i) = fluid_pp(i)%cv
979 qvs(i) = fluid_pp(i)%qv
980 qvps(i) = fluid_pp(i)%qvp
981 end do
982
983# 296 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
984#if defined(MFC_OpenACC)
985# 296 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
986!$acc update device(gammas, isentrope_n, pi_infs, isentrope_B, cvs, qvs, qvps, Gs_vc)
987# 296 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
988#elif defined(MFC_OpenMP)
989# 296 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
990!$omp target update to(gammas, isentrope_n, pi_infs, isentrope_B, cvs, qvs, qvps, Gs_vc)
991# 296 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
992#endif
993
994#ifdef MFC_DEBUG
995# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
996 block
997# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
998 use iso_fortran_env, only: output_unit
999# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1000
1001# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1002 print *, 'm_variables_conversion.fpp:298: ', '@:ALLOCATE(Res_vc(1:2, 1:max(1, Re_size_max)))'
1003# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1004
1005# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1006 call flush (output_unit)
1007# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1008 end block
1009# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1010#endif
1011# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1012 allocate (res_vc(1:2, 1:max(1, re_size_max)))
1013# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1014
1015# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1016
1017# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1018#if defined(MFC_OpenACC)
1019# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1020!$acc enter data create(Res_vc)
1021# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1022#elif defined(MFC_OpenMP)
1023# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1024!$omp target enter data map(always,alloc:Res_vc)
1025# 298 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1026#endif
1027 res_vc = dflt_real
1028 if (allocated(re_idx)) then
1029 do i = 1, 2
1030 do j = 1, re_size(i)
1031 res_vc(i, j) = fluid_pp(re_idx(i, j))%Re(i)
1032 end do
1033 end do
1034
1035# 306 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1036#if defined(MFC_OpenACC)
1037# 306 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1038!$acc update device(Re_idx)
1039# 306 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1040#elif defined(MFC_OpenMP)
1041# 306 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1042!$omp target update to(Re_idx)
1043# 306 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1044#endif
1045 end if
1046
1047# 308 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1048#if defined(MFC_OpenACC)
1049# 308 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1050!$acc update device(Res_vc, Re_size)
1051# 308 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1052#elif defined(MFC_OpenMP)
1053# 308 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1054!$omp target update to(Res_vc, Re_size)
1055# 308 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1056#endif
1057
1058 if (bubbles_euler) then
1059#ifdef MFC_DEBUG
1060# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1061 block
1062# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1063 use iso_fortran_env, only: output_unit
1064# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1065
1066# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1067 print *, 'm_variables_conversion.fpp:311: ', '@:ALLOCATE(bubrs_vc(1:nb))'
1068# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1069
1070# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1071 call flush (output_unit)
1072# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1073 end block
1074# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1075#endif
1076# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1077 allocate (bubrs_vc(1:nb))
1078# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1079
1080# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1081
1082# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1083#if defined(MFC_OpenACC)
1084# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1085!$acc enter data create(bubrs_vc)
1086# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1087#elif defined(MFC_OpenMP)
1088# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1089!$omp target enter data map(always,alloc:bubrs_vc)
1090# 311 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1091#endif
1092 do i = 1, nb
1093 bubrs_vc(i) = qbmm_idx%rs(i)
1094 end do
1095
1096# 315 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1097#if defined(MFC_OpenACC)
1098# 315 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1099!$acc update device(bubrs_vc)
1100# 315 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1101#elif defined(MFC_OpenMP)
1102# 315 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1103!$omp target update to(bubrs_vc)
1104# 315 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1105#endif
1106 end if
1107
1108 if (allocate_mixture_fields) then
1109 ! Allocate derived mixture fields over the available grid storage.
1110 if (n > 0) then
1111 if (p > 0) then
1112 allocate (rho_sf(-buff_size:m + buff_size,-buff_size:n + buff_size,-buff_size:p + buff_size))
1113 allocate (gamma_sf(-buff_size:m + buff_size,-buff_size:n + buff_size,-buff_size:p + buff_size))
1114 allocate (pi_inf_sf(-buff_size:m + buff_size,-buff_size:n + buff_size,-buff_size:p + buff_size))
1115 else
1116 allocate (rho_sf(-buff_size:m + buff_size,-buff_size:n + buff_size,0:0))
1117 allocate (gamma_sf(-buff_size:m + buff_size,-buff_size:n + buff_size,0:0))
1118 allocate (pi_inf_sf(-buff_size:m + buff_size,-buff_size:n + buff_size,0:0))
1119 end if
1120 else
1121 allocate (rho_sf(-buff_size:m + buff_size,0:0,0:0))
1122 allocate (gamma_sf(-buff_size:m + buff_size,0:0,0:0))
1123 allocate (pi_inf_sf(-buff_size:m + buff_size,0:0,0:0))
1124 end if
1125 end if
1126
1127 end subroutine s_initialize_variables_conversion_module
1128
1129 !> Initialize bubble mass-vapor values at quadrature nodes from the conserved moment statistics.
1130 subroutine s_initialize_mv(qK_cons_vf, mv)
1131
1132 type(scalar_field), dimension(sys_size), intent(in) :: qk_cons_vf
1133 real(stp), dimension(idwint(1)%beg:,idwint(2)%beg:,idwint(3)%beg:,1:,1:), intent(inout) :: mv
1134 integer :: i, j, k, l
1135 real(wp) :: mu, sig, nbub_sc
1136
1137 do l = idwint(3)%beg, idwint(3)%end
1138 do k = idwint(2)%beg, idwint(2)%end
1139 do j = idwint(1)%beg, idwint(1)%end
1140 nbub_sc = qk_cons_vf(eqn_idx%bub%beg)%sf(j, k, l)
1141
1142
1143# 352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1144#if defined(MFC_OpenACC)
1145# 352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1146!$acc loop seq
1147# 352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1148#elif defined(MFC_OpenMP)
1149# 352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1150
1151# 352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1152#endif
1153 do i = 1, nb
1154 mu = qk_cons_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc
1155 sig = (qk_cons_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5_wp
1156
1157 mv(j, k, l, 1, i) = (mass_v0(i))*(mu - sig)**(3._wp)/(r0(i)**(3._wp))
1158 mv(j, k, l, 2, i) = (mass_v0(i))*(mu - sig)**(3._wp)/(r0(i)**(3._wp))
1159 mv(j, k, l, 3, i) = (mass_v0(i))*(mu + sig)**(3._wp)/(r0(i)**(3._wp))
1160 mv(j, k, l, 4, i) = (mass_v0(i))*(mu + sig)**(3._wp)/(r0(i)**(3._wp))
1161 end do
1162 end do
1163 end do
1164 end do
1165
1166 end subroutine s_initialize_mv
1167
1168 !> Initialize bubble internal pressures at quadrature nodes using isothermal relations from the Preston model.
1169 subroutine s_initialize_pb(qK_cons_vf, mv, pb)
1170
1171 type(scalar_field), dimension(sys_size), intent(in) :: qk_cons_vf
1172 real(stp), dimension(idwint(1)%beg:,idwint(2)%beg:,idwint(3)%beg:,1:,1:), intent(in) :: mv
1173 real(stp), dimension(idwint(1)%beg:,idwint(2)%beg:,idwint(3)%beg:,1:,1:), intent(inout) :: pb
1174 integer :: i, j, k, l
1175 real(wp) :: mu, sig, nbub_sc
1176
1177 do l = idwint(3)%beg, idwint(3)%end
1178 do k = idwint(2)%beg, idwint(2)%end
1179 do j = idwint(1)%beg, idwint(1)%end
1180 nbub_sc = qk_cons_vf(eqn_idx%bub%beg)%sf(j, k, l)
1181
1182
1183# 382 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1184#if defined(MFC_OpenACC)
1185# 382 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1186!$acc loop seq
1187# 382 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1188#elif defined(MFC_OpenMP)
1189# 382 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1190
1191# 382 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1192#endif
1193 do i = 1, nb
1194 mu = qk_cons_vf(eqn_idx%bub%beg + 1 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc
1195 sig = (qk_cons_vf(eqn_idx%bub%beg + 3 + (i - 1)*nmom)%sf(j, k, l)/nbub_sc - mu**2)**0.5_wp
1196
1197 ! PRESTON (ISOTHERMAL)
1198 pb(j, k, l, 1, i) = (pb0(i))*(r0(i)**(3._wp))*(mass_g0(i) + mv(j, k, l, 1, &
1199 & i))/(mu - sig)**(3._wp)/(mass_g0(i) + mass_v0(i))
1200 pb(j, k, l, 2, i) = (pb0(i))*(r0(i)**(3._wp))*(mass_g0(i) + mv(j, k, l, 2, &
1201 & i))/(mu - sig)**(3._wp)/(mass_g0(i) + mass_v0(i))
1202 pb(j, k, l, 3, i) = (pb0(i))*(r0(i)**(3._wp))*(mass_g0(i) + mv(j, k, l, 3, &
1203 & i))/(mu + sig)**(3._wp)/(mass_g0(i) + mass_v0(i))
1204 pb(j, k, l, 4, i) = (pb0(i))*(r0(i)**(3._wp))*(mass_g0(i) + mv(j, k, l, 4, &
1205 & i))/(mu + sig)**(3._wp)/(mass_g0(i) + mass_v0(i))
1206 end do
1207 end do
1208 end do
1209 end do
1210
1211 end subroutine s_initialize_pb
1212
1213 !> Convert conserved variables (rho*alpha, rho*u, E, alpha) to primitives (rho, u, p, alpha). Conversion depends on model_eqns:
1214 !! each model has different variable sets and EOS.
1215 subroutine s_convert_conservative_to_primitive_variables(qK_cons_vf, q_T_sf, qK_prim_vf, ibounds)
1216
1217 use m_global_parameters_common, only: shear_indices ! Performance fix with AMDFlang
1218
1219 type(scalar_field), dimension(sys_size), intent(in) :: qk_cons_vf
1220 type(scalar_field), intent(inout) :: q_t_sf
1221 type(scalar_field), dimension(sys_size), intent(inout) :: qk_prim_vf
1222 type(int_bounds_info), dimension(1:3), intent(in) :: ibounds
1223
1224# 419 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1225 real(wp), dimension(num_fluids) :: alpha_k, alpha_rho_k
1226 real(wp), dimension(nb) :: nrtmp
1227 real(wp) :: rhoyks(1:num_species)
1228# 423 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1229 real(wp), dimension(2) :: re_k
1230 real(wp) :: rho_k, gamma_k, pi_inf_k, qv_k, dyn_pres_k
1231 real(wp) :: vftmp, nbub_sc
1232 real(wp) :: g_k
1233 real(wp) :: g_damaged !< G_K after the continuum-damage knockdown
1234 real(wp) :: pres
1235 integer :: i, j, k, l !< Generic loop iterators
1236 real(wp) :: t
1237 real(wp) :: pres_mag
1238 real(wp) :: ga !< Lorentz factor (gamma in relativity)
1239 real(wp) :: b2 !< Magnetic field magnitude squared
1240 real(wp) :: b(3) !< Magnetic field components
1241 real(wp) :: m2 !< Relativistic momentum magnitude squared
1242 real(wp) :: s !< Dot product of the magnetic field and the relativistic momentum
1243 real(wp) :: w, dw !< W := rho*v*Ga**2; f = f(W) in Newton-Raphson
1244 real(wp) :: e, d !< Prim/Cons variables within Newton-Raphson iteration
1245 real(wp) :: f, dga_dw, dp_dw, df_dw !< Functions within Newton-Raphson iteration
1246 integer :: iter !< Newton-Raphson iteration counter
1247
1248
1249# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1250
1251# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1252#if defined(MFC_OpenACC)
1253# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1254!$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, G_damaged, T, &
1255# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1256!$acc& pres_mag, Ga, B2, m2, S, W, dW, E, D, f, dGa_dW, dp_dW, df_dW, iter)
1257# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1258#elif defined(MFC_OpenMP)
1259# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1260
1261# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1262
1263# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1264
1265# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1266!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(alpha_K, &
1267# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1268!$omp& 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, G_damaged, T, pres_mag, Ga, B2, m2, S, W, dW, E, D, f, dGa_dW, dp_dW, df_dW, iter)
1269# 442 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1270#endif
1271# 445 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1272 do l = ibounds(3)%beg, ibounds(3)%end
1273 do k = ibounds(2)%beg, ibounds(2)%end
1274 do j = ibounds(1)%beg, ibounds(1)%end
1275 dyn_pres_k = 0._wp
1276
1277 call s_compute_species_fraction(qk_cons_vf, j, k, l, alpha_rho_k, alpha_k)
1278
1279#ifdef MFC_GPU
1280 ! Device regions call the device-compiled scalar kernel directly.
1281 if (hypoelasticity) then
1282 call s_convert_species_to_mixture_variables_kernel(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, alpha_rho_k, &
1283 & re_k, g_k, gs_vc)
1284 else
1285 call s_convert_species_to_mixture_variables_kernel(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, alpha_rho_k, &
1286 & re_k)
1287 end if
1288#else
1289 ! Host execution uses the wrapper, which also stores requested diagnostics.
1290 if (hypoelasticity) then
1291 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, &
1292 & fluid_pp(:)%G)
1293 else
1294 call s_convert_to_mixture_variables(qk_cons_vf, j, k, l, rho_k, gamma_k, pi_inf_k, qv_k)
1295 end if
1296#endif
1297
1298 ! Relativistic MHD primitive variable recovery, Mignone & Bodo A&A (2006)
1299 if (relativity) then
1300 if (n == 0) then
1301 b(1) = bx0
1302 b(2) = qk_cons_vf(eqn_idx%B%beg)%sf(j, k, l)
1303 b(3) = qk_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, l)
1304 else
1305 b(1) = qk_cons_vf(eqn_idx%B%beg)%sf(j, k, l)
1306 b(2) = qk_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, l)
1307 b(3) = qk_cons_vf(eqn_idx%B%beg + 2)%sf(j, k, l)
1308 end if
1309 b2 = b(1)**2 + b(2)**2 + b(3)**2
1310
1311 m2 = 0._wp
1312
1313# 485 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1314#if defined(MFC_OpenACC)
1315# 485 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1316!$acc loop seq
1317# 485 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1318#elif defined(MFC_OpenMP)
1319# 485 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1320
1321# 485 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1322#endif
1323 do i = eqn_idx%mom%beg, eqn_idx%mom%end
1324 m2 = m2 + qk_cons_vf(i)%sf(j, k, l)**2
1325 end do
1326
1327 s = 0._wp
1328
1329# 491 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1330#if defined(MFC_OpenACC)
1331# 491 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1332!$acc loop seq
1333# 491 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1334#elif defined(MFC_OpenMP)
1335# 491 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1336
1337# 491 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1338#endif
1339 do i = 1, 3
1340 s = s + qk_cons_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)*b(i)
1341 end do
1342
1343 e = qk_cons_vf(eqn_idx%E)%sf(j, k, l)
1344
1345 d = 0._wp
1346
1347# 499 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1348#if defined(MFC_OpenACC)
1349# 499 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1350!$acc loop seq
1351# 499 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1352#elif defined(MFC_OpenMP)
1353# 499 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1354
1355# 499 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1356#endif
1357 do i = 1, eqn_idx%cont%end
1358 d = d + qk_cons_vf(i)%sf(j, k, l)
1359 end do
1360
1361 ! Newton-Raphson
1362 w = e + d
1363
1364# 506 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1365#if defined(MFC_OpenACC)
1366# 506 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1367!$acc loop seq
1368# 506 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1369#elif defined(MFC_OpenMP)
1370# 506 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1371
1372# 506 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1373#endif
1374 do iter = 1, relativity_cons_to_prim_max_iter
1375 ! Lorentz factor from total enthalpy and magnetic field
1376 ga = (w + b2)*w/sqrt((w + b2)**2*w**2 - (m2*w**2 + s**2*(2*w + b2)))
1377 ! Thermal pressure from EOS
1378 pres = (w - d*ga)/((gamma_k + 1)*ga**2)
1379 f = w - pres + (1 - 1/(2*ga**2))*b2 - s**2/(2*w**2) - e - d
1380
1381 ! The first equation below corrects a typo in (Mignone & Bodo, 2006) m2*W**2 -> 2*m2*W**2, which would
1382 ! cancel with the 2* in other terms This corrected version is not used as the second equation
1383 ! empirically converges faster. First equation is kept for further investigation. dGa_dW = -Ga**3 * (
1384 ! S**2*(3*W**2+3*W*B2+B2**2) + m2*W**2 ) / (W**3 * (W+B2)**3) ! first (corrected)
1385 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)
1386
1387 dp_dw = (ga*(1 + d*dga_dw) - 2*w*dga_dw)/((gamma_k + 1)*ga**3)
1388 df_dw = 1 - dp_dw + (b2/ga**3)*dga_dw + s**2/w**3
1389
1390 dw = -f/df_dw
1391 w = w + dw
1392 if (abs(dw) < 1.e-12_wp*w) exit ! Relative convergence criterion
1393 end do
1394
1395 ! Recalculate pressure using converged W
1396 ga = (w + b2)*w/sqrt((w + b2)**2*w**2 - (m2*w**2 + s**2*(2*w + b2)))
1397 qk_prim_vf(eqn_idx%E)%sf(j, k, l) = (w - d*ga)/((gamma_k + 1)*ga**2)
1398
1399 ! Recover the other primitive variables
1400
1401# 533 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1402#if defined(MFC_OpenACC)
1403# 533 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1404!$acc loop seq
1405# 533 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1406#elif defined(MFC_OpenMP)
1407# 533 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1408
1409# 533 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1410#endif
1411 do i = 1, 3
1412 qk_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l) = (qk_cons_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, &
1413 & l) + (s/w)*b(i))/(w + b2)
1414 end do
1415 qk_prim_vf(1)%sf(j, k, l) = d/ga ! Hard-coded for single-component for now
1416
1417
1418# 540 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1419#if defined(MFC_OpenACC)
1420# 540 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1421!$acc loop seq
1422# 540 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1423#elif defined(MFC_OpenMP)
1424# 540 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1425
1426# 540 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1427#endif
1428 do i = eqn_idx%B%beg, eqn_idx%B%end
1429 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)
1430 end do
1431
1432 cycle ! skip all the non-relativistic conversions below
1433 end if
1434
1435 if (chemistry) then
1436 ! Reacting flow: recover density from species partial densities, compute mass fractions Y_k = rhoY_k / rho
1437 rho_k = 0._wp
1438
1439# 551 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1440#if defined(MFC_OpenACC)
1441# 551 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1442!$acc loop seq
1443# 551 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1444#elif defined(MFC_OpenMP)
1445# 551 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1446
1447# 551 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1448#endif
1449 do i = eqn_idx%species%beg, eqn_idx%species%end
1450 rho_k = rho_k + max(0._wp, qk_cons_vf(i)%sf(j, k, l))
1451 end do
1452
1453
1454# 556 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1455#if defined(MFC_OpenACC)
1456# 556 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1457!$acc loop seq
1458# 556 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1459#elif defined(MFC_OpenMP)
1460# 556 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1461
1462# 556 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1463#endif
1464 do i = 1, eqn_idx%cont%end
1465 qk_prim_vf(i)%sf(j, k, l) = rho_k
1466 end do
1467
1468
1469# 561 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1470#if defined(MFC_OpenACC)
1471# 561 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1472!$acc loop seq
1473# 561 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1474#elif defined(MFC_OpenMP)
1475# 561 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1476
1477# 561 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1478#endif
1479 do i = eqn_idx%species%beg, eqn_idx%species%end
1480 qk_prim_vf(i)%sf(j, k, l) = max(0._wp, qk_cons_vf(i)%sf(j, k, l)/rho_k)
1481 end do
1482 else
1483 ! Non-reacting: partial densities are directly primitive (alpha_i * rho_i)
1484
1485# 567 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1486#if defined(MFC_OpenACC)
1487# 567 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1488!$acc loop seq
1489# 567 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1490#elif defined(MFC_OpenMP)
1491# 567 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1492
1493# 567 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1494#endif
1495 do i = 1, eqn_idx%cont%end
1496 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)
1497 end do
1498 end if
1499
1500 if (enforce_density_floor_vc) rho_k = max(rho_k, sgm_eps)
1501
1502 ! Recover velocity from momentum: u = rho*u / rho, and accumulate dynamic pressure 0.5*rho*|u|^2
1503
1504# 576 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1505#if defined(MFC_OpenACC)
1506# 576 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1507!$acc loop seq
1508# 576 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1509#elif defined(MFC_OpenMP)
1510# 576 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1511
1512# 576 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1513#endif
1514 do i = eqn_idx%mom%beg, eqn_idx%mom%end
1515 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)/rho_k
1516 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)
1517 end do
1518
1519 if (chemistry) then
1520
1521# 583 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1522#if defined(MFC_OpenACC)
1523# 583 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1524!$acc loop seq
1525# 583 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1526#elif defined(MFC_OpenMP)
1527# 583 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1528
1529# 583 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1530#endif
1531 do i = 1, num_species
1532 rhoyks(i) = qk_cons_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l)
1533 end do
1534
1535 t = q_t_sf%sf(j, k, l)
1536 end if
1537
1538 if (mhd) then
1539 if (n == 0) then
1540 pres_mag = 0.5_wp*(bx0**2 + qk_cons_vf(eqn_idx%B%beg)%sf(j, k, &
1541 & l)**2 + qk_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, l)**2)
1542 else
1543 pres_mag = 0.5_wp*(qk_cons_vf(eqn_idx%B%beg)%sf(j, k, l)**2 + qk_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, &
1544 & l)**2 + qk_cons_vf(eqn_idx%B%beg + 2)%sf(j, k, l)**2)
1545 end if
1546 else
1547 pres_mag = 0._wp
1548 end if
1549
1550 call s_compute_pressure(qk_cons_vf(eqn_idx%E)%sf(j, k, l), qk_cons_vf(eqn_idx%alf)%sf(j, k, l), dyn_pres_k, &
1551 & pi_inf_k, gamma_k, rho_k, qv_k, rhoyks, pres, t, pres_mag=pres_mag)
1552
1553 qk_prim_vf(eqn_idx%E)%sf(j, k, l) = pres
1554
1555 if (chemistry) then
1556 q_t_sf%sf(j, k, l) = t
1557 end if
1558
1559 if (bubbles_euler) then
1560 ! Recover bubble primitive variables: divide conserved moments by bubble number density
1561
1562# 614 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1563#if defined(MFC_OpenACC)
1564# 614 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1565!$acc loop seq
1566# 614 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1567#elif defined(MFC_OpenMP)
1568# 614 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1569
1570# 614 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1571#endif
1572 do i = 1, nb
1573 nrtmp(i) = qk_cons_vf(bubrs_vc(i))%sf(j, k, l)
1574 end do
1575
1576 vftmp = qk_cons_vf(eqn_idx%alf)%sf(j, k, l)
1577
1578 if (qbmm) then
1579 ! Get nb (constant across all R0 bins)
1580 nbub_sc = qk_cons_vf(eqn_idx%bub%beg)%sf(j, k, l)
1581
1582 ! Convert cons to prim
1583
1584# 626 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1585#if defined(MFC_OpenACC)
1586# 626 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1587!$acc loop seq
1588# 626 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1589#elif defined(MFC_OpenMP)
1590# 626 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1591
1592# 626 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1593#endif
1594 do i = eqn_idx%bub%beg, eqn_idx%bub%end
1595 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)/nbub_sc
1596 end do
1597 ! Need to keep track of nb in the primitive variable list (converted back to true value before output)
1598 if (preserve_qbmm_number_vc) then
1599 qk_prim_vf(eqn_idx%bub%beg)%sf(j, k, l) = qk_cons_vf(eqn_idx%bub%beg)%sf(j, k, l)
1600 end if
1601 else
1602 if (adv_n) then
1603 qk_prim_vf(eqn_idx%n)%sf(j, k, l) = qk_cons_vf(eqn_idx%n)%sf(j, k, l)
1604 nbub_sc = qk_prim_vf(eqn_idx%n)%sf(j, k, l)
1605 else
1606 call s_comp_n_from_cons(vftmp, nrtmp, nbub_sc, weight)
1607 end if
1608
1609
1610# 642 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1611#if defined(MFC_OpenACC)
1612# 642 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1613!$acc loop seq
1614# 642 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1615#elif defined(MFC_OpenMP)
1616# 642 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1617
1618# 642 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1619#endif
1620 do i = eqn_idx%bub%beg, eqn_idx%bub%end
1621 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)/nbub_sc
1622 end do
1623 end if
1624 end if
1625
1626 if (mhd) then
1627
1628# 650 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1629#if defined(MFC_OpenACC)
1630# 650 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1631!$acc loop seq
1632# 650 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1633#elif defined(MFC_OpenMP)
1634# 650 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1635
1636# 650 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1637#endif
1638 do i = eqn_idx%B%beg, eqn_idx%B%end
1639 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)
1640 end do
1641 end if
1642
1643 if (hypoelasticity) then
1644
1645# 657 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1646#if defined(MFC_OpenACC)
1647# 657 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1648!$acc loop seq
1649# 657 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1650#elif defined(MFC_OpenMP)
1651# 657 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1652
1653# 657 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1654#endif
1655 do i = eqn_idx%stress%beg, eqn_idx%stress%end
1656 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)/rho_k
1657 end do
1658 end if
1659
1660 if (hypoelasticity) then
1661 ! The knockdown lands in its own variable rather than back in G_K. Self-assigning a scalar
1662 ! inside an offloaded teams loop makes NVHPC infer an implicit reduction(*:G_K) - even
1663 ! though G_K is private - and the reduction epilogue it then emits faults on an accumulator
1664 ! that does not exist. The block is dead unless hypoelasticity, but the epilogue is not.
1665 g_damaged = g_k
1666 if (cont_damage) g_damaged = g_k*max((1._wp - qk_cons_vf(eqn_idx%damage)%sf(j, k, l)), 0._wp)
1667
1668# 670 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1669#if defined(MFC_OpenACC)
1670# 670 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1671!$acc loop seq
1672# 670 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1673#elif defined(MFC_OpenMP)
1674# 670 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1675
1676# 670 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1677#endif
1678 do i = eqn_idx%stress%beg, eqn_idx%stress%end
1679 qk_prim_vf(eqn_idx%E)%sf(j, k, l) = qk_prim_vf(eqn_idx%E)%sf(j, k, &
1680 & l) - f_elastic_energy(real(qk_prim_vf(i)%sf(j, k, l), wp), g_damaged, &
1681 & any(i == shear_indices))/gamma_k
1682 end do
1683 end if
1684
1685 if (.not. igr .or. num_fluids > 1) then
1686
1687# 679 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1688#if defined(MFC_OpenACC)
1689# 679 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1690!$acc loop seq
1691# 679 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1692#elif defined(MFC_OpenMP)
1693# 679 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1694
1695# 679 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1696#endif
1697 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1698 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)
1699 end do
1700 end if
1701
1702 if (surface_tension) then
1703 qk_prim_vf(eqn_idx%c)%sf(j, k, l) = qk_cons_vf(eqn_idx%c)%sf(j, k, l)
1704 end if
1705
1706 if (cont_damage) qk_prim_vf(eqn_idx%damage)%sf(j, k, l) = qk_cons_vf(eqn_idx%damage)%sf(j, k, l)
1707
1708 if (hyper_cleaning) qk_prim_vf(eqn_idx%psi)%sf(j, k, l) = qk_cons_vf(eqn_idx%psi)%sf(j, k, l)
1709 if (bubbles_lagrange .and. lagrange_beta_index_vc > 0) then
1710 qk_prim_vf(lagrange_beta_index_vc)%sf(j, k, l) = qk_cons_vf(lagrange_beta_index_vc)%sf(j, k, l)
1711 end if
1712 end do
1713 end do
1714 end do
1715
1716# 698 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1717#if defined(MFC_OpenACC)
1718# 698 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1719!$acc end parallel loop
1720# 698 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1721#elif defined(MFC_OpenMP)
1722# 698 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1723
1724# 698 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1725!$omp end target teams loop
1726# 698 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1727#endif
1728
1729 end subroutine s_convert_conservative_to_primitive_variables
1730
1731 !> Convert primitives (rho, u, p, alpha) to conserved variables (rho*alpha, rho*u, E, alpha).
1732 impure subroutine s_convert_primitive_to_conservative_variables(q_prim_vf, q_cons_vf)
1733
1734 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1735 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
1736
1737 ! Density, specific heat ratio function, liquid stiffness function and dynamic pressure, as defined in the incompressible
1738 ! flow sense, respectively
1739 real(wp) :: rho
1740 real(wp) :: gamma
1741 real(wp) :: pi_inf
1742 real(wp) :: qv
1743 real(wp) :: dyn_pres
1744 real(wp) :: nbub, r3tmp
1745 real(wp), dimension(nb) :: rtmp
1746 real(wp) :: g
1747 real(wp), dimension(2) :: re_k
1748 integer :: i, j, k, l !< Generic loop iterators
1749 real(wp), dimension(num_species) :: ys
1750 real(wp) :: e_mix, mix_mol_weight, t
1751 real(wp) :: pres_mag
1752 real(wp) :: ga !< Lorentz factor (gamma in relativity)
1753 real(wp) :: h !< relativistic enthalpy
1754 real(wp) :: v2 !< Square of the velocity magnitude
1755 real(wp) :: b2 !< Square of the magnetic field magnitude
1756 real(wp) :: vdotb !< Dot product of the velocity and magnetic field vectors
1757 real(wp) :: b(3) !< Magnetic field components
1758
1759 pres_mag = 0._wp
1760
1761 g = 0._wp
1762
1763 ! Converting the primitive variables to the conservative variables
1764 do l = 0, p
1765 do k = 0, n
1766 do j = 0, m
1767 ! Obtaining the density, specific heat ratio function and the liquid stiffness function, respectively
1768 call s_convert_to_mixture_variables(q_prim_vf, j, k, l, rho, gamma, pi_inf, qv, re_k, g, fluid_pp(:)%G)
1769
1770 if (.not. igr .or. num_fluids > 1) then
1771 ! Transferring the advection equation(s) variable(s)
1772 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1773 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
1774 end do
1775 end if
1776
1777 if (relativity) then
1778 if (n == 0) then
1779 b(1) = bx0
1780 b(2) = q_prim_vf(eqn_idx%B%beg)%sf(j, k, l)
1781 b(3) = q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l)
1782 else
1783 b(1) = q_prim_vf(eqn_idx%B%beg)%sf(j, k, l)
1784 b(2) = q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l)
1785 b(3) = q_prim_vf(eqn_idx%B%beg + 2)%sf(j, k, l)
1786 end if
1787
1788 v2 = 0._wp
1789 do i = eqn_idx%mom%beg, eqn_idx%mom%end
1790 v2 = v2 + q_prim_vf(i)%sf(j, k, l)**2
1791 end do
1792 if (v2 >= 1._wp) call s_mpi_abort('Error: v squared > 1 in s_convert_primitive_to_conservative_variables')
1793
1794 ga = 1._wp/sqrt(1._wp - v2)
1795
1796 h = 1._wp + (gamma + 1)*q_prim_vf(eqn_idx%E)%sf(j, k, l)/rho ! Assume perfect gas for now
1797
1798 b2 = 0._wp
1799 do i = eqn_idx%B%beg, eqn_idx%B%end
1800 b2 = b2 + q_prim_vf(i)%sf(j, k, l)**2
1801 end do
1802 if (n == 0) b2 = b2 + bx0**2
1803
1804 vdotb = 0._wp
1805 do i = 1, 3
1806 vdotb = vdotb + q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)*b(i)
1807 end do
1808
1809 do i = 1, eqn_idx%cont%end
1810 q_cons_vf(i)%sf(j, k, l) = ga*q_prim_vf(i)%sf(j, k, l)
1811 end do
1812
1813 do i = eqn_idx%mom%beg, eqn_idx%mom%end
1814 q_cons_vf(i)%sf(j, k, l) = (rho*h*ga**2 + b2)*q_prim_vf(i)%sf(j, k, &
1815 & l) - vdotb*b(i - eqn_idx%mom%beg + 1)
1816 end do
1817
1818 q_cons_vf(eqn_idx%E)%sf(j, k, l) = rho*h*ga**2 - q_prim_vf(eqn_idx%E)%sf(j, k, &
1819 & l) + 0.5_wp*(b2 + v2*b2 - vdotb**2)
1820 ! Remove rest energy
1821 do i = 1, eqn_idx%cont%end
1822 q_cons_vf(eqn_idx%E)%sf(j, k, l) = q_cons_vf(eqn_idx%E)%sf(j, k, l) - q_cons_vf(i)%sf(j, k, l)
1823 end do
1824
1825 do i = eqn_idx%B%beg, eqn_idx%B%end
1826 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
1827 end do
1828
1829 cycle ! skip all the non-relativistic conversions below
1830 end if
1831
1832 ! Transferring the continuity equation(s) variable(s)
1833 do i = 1, eqn_idx%cont%end
1834 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
1835 end do
1836
1837 ! Zeroing out the dynamic pressure since it is computed iteratively by cycling through the velocity equations
1838 dyn_pres = 0._wp
1839
1840 ! Computing momenta and dynamic pressure from velocity
1841 do i = eqn_idx%mom%beg, eqn_idx%mom%end
1842 q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l)
1843 dyn_pres = dyn_pres + q_cons_vf(i)%sf(j, k, l)*q_prim_vf(i)%sf(j, k, l)/2._wp
1844 end do
1845
1846 if (chemistry) then
1847 ! Reacting mixture: compute conserved energy from species mass fractions and temperature
1848 do i = eqn_idx%species%beg, eqn_idx%species%end
1849 ys(i - eqn_idx%species%beg + 1) = q_prim_vf(i)%sf(j, k, l)
1850 q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l)
1851 end do
1852
1853 call get_mixture_molecular_weight(ys, mix_mol_weight)
1854 t = q_prim_vf(eqn_idx%E)%sf(j, k, l)*mix_mol_weight/(gas_constant*rho)
1855 call get_mixture_energy_mass(t, ys, e_mix)
1856
1857 q_cons_vf(eqn_idx%E)%sf(j, k, l) = dyn_pres + rho*e_mix
1858 else
1859 ! Computing the energy from the pressure
1860 if (mhd) then
1861 if (n == 0) then
1862 pres_mag = 0.5_wp*(bx0**2 + q_prim_vf(eqn_idx%B%beg)%sf(j, k, &
1863 & l)**2 + q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l)**2)
1864 else
1865 pres_mag = 0.5_wp*(q_prim_vf(eqn_idx%B%beg)%sf(j, k, l)**2 + q_prim_vf(eqn_idx%B%beg + 1)%sf(j, &
1866 & k, l)**2 + q_prim_vf(eqn_idx%B%beg + 2)%sf(j, k, l)**2)
1867 end if
1868 ! MHD energy includes magnetic pressure contribution
1869 q_cons_vf(eqn_idx%E)%sf(j, k, l) = gamma*q_prim_vf(eqn_idx%E)%sf(j, k, &
1870 & l) + dyn_pres + pres_mag + pi_inf + qv
1871 else if (bubbles_euler .neqv. .true.) then
1872 ! Five-equation model (Allaire et al. JCP 2002): E = Gamma*p + 0.5*rho*|u|^2 + pi_inf + qv
1873 q_cons_vf(eqn_idx%E)%sf(j, k, l) = gamma*q_prim_vf(eqn_idx%E)%sf(j, k, l) + dyn_pres + pi_inf + qv
1874 else
1875 ! Bubble-augmented energy; qv is an energy density and is not diluted
1876 q_cons_vf(eqn_idx%E)%sf(j, k, l) = dyn_pres + (1._wp - q_prim_vf(eqn_idx%alf)%sf(j, k, &
1877 & l))*(gamma*q_prim_vf(eqn_idx%E)%sf(j, k, l) + pi_inf) + qv
1878 end if
1879 end if
1880
1881 ! Six-equation model (Saurel et al. JCP 2009): compute per-phase internal energies
1882 if (model_eqns == model_eqns_6eq) then
1883 do i = 1, num_fluids
1884 q_cons_vf(i + eqn_idx%int_en%beg - 1)%sf(j, k, l) = q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, &
1885 & l)*(gammas(i)*q_prim_vf(eqn_idx%E)%sf(j, k, &
1886 & l) + pi_infs(i)) + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*qvs(i)
1887 end do
1888 end if
1889
1890 if (bubbles_euler) then
1891 ! From prim: Compute nbub = (3/4pi) * \alpha / \bar{R^3}
1892 do i = 1, nb
1893 rtmp(i) = q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l)
1894 end do
1895
1896 if (.not. qbmm) then
1897 if (adv_n) then
1898 q_cons_vf(eqn_idx%n)%sf(j, k, l) = q_prim_vf(eqn_idx%n)%sf(j, k, l)
1899 nbub = q_prim_vf(eqn_idx%n)%sf(j, k, l)
1900 else
1901 call s_comp_n_from_prim(real(q_prim_vf(eqn_idx%alf)%sf(j, k, l), kind=wp), rtmp, nbub, weight)
1902 end if
1903 else
1904 ! Initialize R3 averaging over R0 and R directions
1905 r3tmp = 0._wp
1906 do i = 1, nb
1907 r3tmp = r3tmp + weight(i)*0.5_wp*(rtmp(i) + sigr)**3._wp
1908 r3tmp = r3tmp + weight(i)*0.5_wp*(rtmp(i) - sigr)**3._wp
1909 end do
1910 ! Initialize nb
1911 nbub = 3._wp*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4._wp*pi*r3tmp)
1912 end if
1913
1914 do i = eqn_idx%bub%beg, eqn_idx%bub%end
1915 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)*nbub
1916 end do
1917 end if
1918
1919 if (mhd) then
1920 do i = eqn_idx%B%beg, eqn_idx%B%end
1921 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
1922 end do
1923 end if
1924
1925 if (hypoelasticity) then
1926 ! adding the elastic contribution Multiply \tau to \rho \tau
1927 do i = eqn_idx%stress%beg, eqn_idx%stress%end
1928 q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l)
1929 end do
1930 end if
1931
1932 if (hypoelasticity) then
1933 if (cont_damage) g = g*max((1._wp - q_prim_vf(eqn_idx%damage)%sf(j, k, l)), 0._wp)
1934 do i = eqn_idx%stress%beg, eqn_idx%stress%end
1935 ! Elastic energy addition (guard skips when G near zero from alpha undershoot)
1936 if (g > verysmall) then
1937 q_cons_vf(eqn_idx%E)%sf(j, k, l) = q_cons_vf(eqn_idx%E)%sf(j, k, l) + (q_prim_vf(i)%sf(j, k, &
1938 & l)**2._wp)/max(4._wp*g, verysmall)
1939 ! Double for shear stresses
1940 if (any(i == shear_indices)) then
1941 q_cons_vf(eqn_idx%E)%sf(j, k, l) = q_cons_vf(eqn_idx%E)%sf(j, k, l) + (q_prim_vf(i)%sf(j, k, &
1942 & l)**2._wp)/max(4._wp*g, verysmall)
1943 end if
1944 end if
1945 end do
1946 end if
1947
1948 if (surface_tension) then
1949 q_cons_vf(eqn_idx%c)%sf(j, k, l) = q_prim_vf(eqn_idx%c)%sf(j, k, l)
1950 end if
1951
1952 if (cont_damage) q_cons_vf(eqn_idx%damage)%sf(j, k, l) = q_prim_vf(eqn_idx%damage)%sf(j, k, l)
1953
1954 if (hyper_cleaning) q_cons_vf(eqn_idx%psi)%sf(j, k, l) = q_prim_vf(eqn_idx%psi)%sf(j, k, l)
1955 end do
1956 end do
1957 end do
1958
1959 end subroutine s_convert_primitive_to_conservative_variables
1960
1961 !> Convert primitive variables to Eulerian flux variables.
1962 subroutine s_convert_primitive_to_flux_variables(qK_prim_vf, FK_vf, FK_src_vf, is1, is2, is3, s2b, s3b, dir_idx_in, &
1963 & dir_flg_in, hll_u_interface_in)
1964
1965 integer, intent(in) :: s2b, s3b
1966 !> Working-direction mapping, passed explicitly: it is simulation state (m_global_parameters), and use-associating it into
1967 !! this common kernel spills registers on AMD OpenMP offload.
1968 integer, dimension(3), intent(in) :: dir_idx_in
1969 real(wp), dimension(3), intent(in) :: dir_flg_in
1970 logical, intent(in) :: hll_u_interface_in
1971 real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(in) :: qk_prim_vf
1972 real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: fk_vf
1973 real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,eqn_idx%adv%beg:), intent(inout) :: fk_src_vf
1974 type(int_bounds_info), intent(in) :: is1, is2, is3
1975
1976 ! Partial densities, density, velocity, pressure, energy, advection variables, the specific heat ratio and liquid stiffness
1977 ! functions, the shear and volume Reynolds numbers and the Weber numbers
1978
1979# 956 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1980 real(wp), dimension(num_fluids) :: alpha_rho_k
1981 real(wp), dimension(num_fluids) :: alpha_k
1982 real(wp), dimension(num_vels) :: vel_k
1983 real(wp), dimension(num_species) :: y_k
1984# 961 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1985 real(wp) :: rho_k
1986 real(wp) :: vel_k_sum
1987 real(wp) :: pres_k
1988 real(wp) :: e_k
1989 real(wp) :: gamma_k
1990 real(wp) :: pi_inf_k
1991 real(wp) :: qv_k
1992 real(wp), dimension(2) :: re_k
1993 real(wp) :: g_k
1994 real(wp) :: blkmod1_k, blkmod2_k, k_k
1995 real(wp) :: t_k, mix_mol_weight, r_gas
1996 integer :: i, j, k, l !< Generic loop iterators
1997
1998 is1b = is1%beg; is1e = is1%end
1999 is2b = is2%beg; is2e = is2%end
2000 is3b = is3%beg; is3e = is3%end
2001
2002
2003# 978 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2004#if defined(MFC_OpenACC)
2005# 978 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2006!$acc update device(is1b, is2b, is3b, is1e, is2e, is3e)
2007# 978 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2008#elif defined(MFC_OpenMP)
2009# 978 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2010!$omp target update to(is1b, is2b, is3b, is1e, is2e, is3e)
2011# 978 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2012#endif
2013
2014 ! Computing the flux variables from the primitive variables, without accounting for the contribution of either viscosity or
2015 ! capillarity
2016
2017# 982 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2018
2019# 982 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2020#if defined(MFC_OpenACC)
2021# 982 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2022!$acc parallel loop collapse(3) gang vector default(present) &
2023# 982 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2024!$acc& 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, blkmod1_K, blkmod2_K, K_K, T_K, mix_mol_weight, R_gas) &
2025# 982 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2026!$acc& copyin(dir_idx_in, dir_flg_in, hll_u_interface_in)
2027# 982 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2028#elif defined(MFC_OpenMP)
2029# 982 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2030
2031# 982 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2032
2033# 982 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2034
2035# 982 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2036!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
2037# 982 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2038!$omp& 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, blkmod1_K, blkmod2_K, K_K, T_K, mix_mol_weight, R_gas) &
2039# 982 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2040!$omp& map(to:dir_idx_in, dir_flg_in, hll_u_interface_in)
2041# 982 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2042#endif
2043# 985 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2044 do l = is3b, is3e
2045 do k = is2b, is2e
2046 do j = is1b, is1e
2047
2048# 988 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2049#if defined(MFC_OpenACC)
2050# 988 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2051!$acc loop seq
2052# 988 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2053#elif defined(MFC_OpenMP)
2054# 988 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2055
2056# 988 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2057#endif
2058 do i = 1, eqn_idx%cont%end
2059 alpha_rho_k(i) = qk_prim_vf(j, k, l, i)
2060 end do
2061
2062
2063# 993 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2064#if defined(MFC_OpenACC)
2065# 993 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2066!$acc loop seq
2067# 993 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2068#elif defined(MFC_OpenMP)
2069# 993 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2070
2071# 993 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2072#endif
2073 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2074 alpha_k(i - eqn_idx%E) = qk_prim_vf(j, k, l, i)
2075 end do
2076
2077
2078# 998 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2079#if defined(MFC_OpenACC)
2080# 998 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2081!$acc loop seq
2082# 998 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2083#elif defined(MFC_OpenMP)
2084# 998 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2085
2086# 998 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2087#endif
2088 do i = 1, num_vels
2089 vel_k(i) = qk_prim_vf(j, k, l, eqn_idx%cont%end + i)
2090 end do
2091
2092 vel_k_sum = 0._wp
2093
2094# 1004 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2095#if defined(MFC_OpenACC)
2096# 1004 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2097!$acc loop seq
2098# 1004 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2099#elif defined(MFC_OpenMP)
2100# 1004 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2101
2102# 1004 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2103#endif
2104 do i = 1, num_vels
2105 vel_k_sum = vel_k_sum + vel_k(i)**2._wp
2106 end do
2107
2108 pres_k = qk_prim_vf(j, k, l, eqn_idx%E)
2109 if (hypoelasticity) then
2110 call s_convert_species_to_mixture_variables_kernel(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, alpha_rho_k, &
2111 & re_k, g_k, gs_vc)
2112 else
2113 call s_convert_species_to_mixture_variables_kernel(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, alpha_rho_k, &
2114 & re_k)
2115 end if
2116
2117 ! Computing the energy from the pressure
2118
2119 if (chemistry) then
2120
2121# 1021 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2122#if defined(MFC_OpenACC)
2123# 1021 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2124!$acc loop seq
2125# 1021 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2126#elif defined(MFC_OpenMP)
2127# 1021 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2128
2129# 1021 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2130#endif
2131 do i = eqn_idx%species%beg, eqn_idx%species%end
2132 y_k(i - eqn_idx%species%beg + 1) = qk_prim_vf(j, k, l, i)
2133 end do
2134 ! Computing the energy from the internal energy of the mixture
2135 call get_mixture_molecular_weight(y_k, mix_mol_weight)
2136 r_gas = gas_constant/mix_mol_weight
2137 t_k = pres_k/rho_k/r_gas
2138 call get_mixture_energy_mass(t_k, y_k, e_k)
2139 e_k = rho_k*e_k + 5.e-1_wp*rho_k*vel_k_sum
2140 else
2141 ! Computing the energy from the pressure
2142 e_k = gamma_k*pres_k + pi_inf_k + 5.e-1_wp*rho_k*vel_k_sum + qv_k
2143 end if
2144
2145 ! mass flux, this should be \alpha_i \rho_i u_i
2146
2147# 1037 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2148#if defined(MFC_OpenACC)
2149# 1037 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2150!$acc loop seq
2151# 1037 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2152#elif defined(MFC_OpenMP)
2153# 1037 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2154
2155# 1037 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2156#endif
2157 do i = 1, eqn_idx%cont%end
2158 fk_vf(j, k, l, i) = alpha_rho_k(i)*vel_k(dir_idx_in(1))
2159 end do
2160
2161
2162# 1042 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2163#if defined(MFC_OpenACC)
2164# 1042 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2165!$acc loop seq
2166# 1042 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2167#elif defined(MFC_OpenMP)
2168# 1042 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2169
2170# 1042 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2171#endif
2172 do i = 1, num_vels
2173 fk_vf(j, k, l, &
2174 & eqn_idx%cont%end + dir_idx_in(i)) = rho_k*vel_k(dir_idx_in(1))*vel_k(dir_idx_in(i)) &
2175 & + pres_k*dir_flg_in(dir_idx_in(i))
2176 end do
2177
2178 ! energy flux, u(E+p)
2179 fk_vf(j, k, l, eqn_idx%E) = vel_k(dir_idx_in(1))*(e_k + pres_k)
2180
2181 ! Species advection Flux, \rho*u*Y
2182 if (chemistry) then
2183
2184# 1054 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2185#if defined(MFC_OpenACC)
2186# 1054 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2187!$acc loop seq
2188# 1054 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2189#elif defined(MFC_OpenMP)
2190# 1054 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2191
2192# 1054 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2193#endif
2194 do i = 1, num_species
2195 fk_vf(j, k, l, i - 1 + eqn_idx%species%beg) = vel_k(dir_idx_in(1))*(rho_k*y_k(i))
2196 end do
2197 end if
2198
2199 ! Match the volume-fraction flux representation exported by the Riemann solver. HLL Method 1: zero alpha
2200 ! flux plus per-fluid interface-alpha source traces. Hypoelastic HLLD folds every non-conservative term
2201 ! into its augmented flux (adv_src_mode_none), so its source trace is zero; for this cell-local conversion
2202 ! the fold collapses exactly to -/+ K*u_n on the two volume-fraction rows (K = 0 without alt_soundspeed),
2203 ! with the same two-fluid longitudinal-modulus K as the HLLD kernel (num_fluids = 2 is checker-enforced).
2204 ! MHD HLLD keeps the per-fluid-trace representation it has always used. HLL Method 2, HLLC, and LF use the
2205 ! shared-velocity representation below.
2206 if (riemann_solver == riemann_solver_hlld) then
2207 if (hypoelasticity) then
2208 k_k = 0._wp
2209 ! The fluid-2 subscripts must not be compiled when case optimization
2210 ! bakes num_fluids = 1 (amdflang rejects them at compile time); the
2211 ! checker prohibits hypoelastic HLLD there, so the block is dead code.
2212# 1074 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2213 if (alt_soundspeed) then
2214 blkmod1_k = f_bulk_modulus(pres_k, gammas(1), pi_infs(1)) + (4._wp/3._wp)*gs_vc(1)
2215 blkmod2_k = f_bulk_modulus(pres_k, gammas(2), pi_infs(2)) + (4._wp/3._wp)*gs_vc(2)
2216 k_k = alpha_k(1)*alpha_k(2)*(blkmod2_k - blkmod1_k)/(alpha_k(1)*blkmod2_k + alpha_k(2) &
2217 & *blkmod1_k + verysmall)
2218 end if
2219# 1081 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2220
2221# 1081 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2222#if defined(MFC_OpenACC)
2223# 1081 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2224!$acc loop seq
2225# 1081 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2226#elif defined(MFC_OpenMP)
2227# 1081 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2228
2229# 1081 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2230#endif
2231 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2232 fk_vf(j, k, l, i) = 0._wp
2233 fk_src_vf(j, k, l, i) = 0._wp
2234 end do
2235 fk_vf(j, k, l, eqn_idx%adv%beg) = -k_k*vel_k(dir_idx_in(1))
2236 fk_vf(j, k, l, eqn_idx%adv%end) = k_k*vel_k(dir_idx_in(1))
2237 else
2238
2239# 1089 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2240#if defined(MFC_OpenACC)
2241# 1089 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2242!$acc loop seq
2243# 1089 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2244#elif defined(MFC_OpenMP)
2245# 1089 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2246
2247# 1089 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2248#endif
2249 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2250 fk_vf(j, k, l, i) = 0._wp
2251 fk_src_vf(j, k, l, i) = alpha_k(i - eqn_idx%E)
2252 end do
2253 end if
2254 else if (riemann_solver == riemann_solver_hll .and. .not. hll_u_interface_in) then
2255
2256# 1096 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2257#if defined(MFC_OpenACC)
2258# 1096 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2259!$acc loop seq
2260# 1096 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2261#elif defined(MFC_OpenMP)
2262# 1096 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2263
2264# 1096 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2265#endif
2266 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2267 fk_vf(j, k, l, i) = 0._wp
2268 fk_src_vf(j, k, l, i) = alpha_k(i - eqn_idx%E)
2269 end do
2270 else
2271 ! Could be bubbles_euler!
2272
2273# 1103 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2274#if defined(MFC_OpenACC)
2275# 1103 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2276!$acc loop seq
2277# 1103 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2278#elif defined(MFC_OpenMP)
2279# 1103 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2280
2281# 1103 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2282#endif
2283 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2284 fk_vf(j, k, l, i) = vel_k(dir_idx_in(1))*alpha_k(i - eqn_idx%E)
2285 end do
2286
2287
2288# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2289#if defined(MFC_OpenACC)
2290# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2291!$acc loop seq
2292# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2293#elif defined(MFC_OpenMP)
2294# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2295
2296# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2297#endif
2298 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2299 fk_src_vf(j, k, l, i) = vel_k(dir_idx_in(1))
2300 end do
2301 end if
2302 end do
2303 end do
2304 end do
2305
2306# 1116 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2307#if defined(MFC_OpenACC)
2308# 1116 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2309!$acc end parallel loop
2310# 1116 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2311#elif defined(MFC_OpenMP)
2312# 1116 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2313
2314# 1116 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2315!$omp end target teams loop
2316# 1116 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2317#endif
2318
2319 end subroutine s_convert_primitive_to_flux_variables
2320
2321 !> Compute partial densities and volume fractions
2322 subroutine s_compute_species_fraction(q_vf, k, l, r, alpha_rho_K, alpha_K)
2323
2324
2325# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2326#ifdef _CRAYFTN
2327# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2328#if MFC_OpenACC
2329# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2330!$acc routine seq
2331# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2332#elif MFC_OpenMP
2333# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2334
2335# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2336
2337# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2338!$omp declare target device_type(any)
2339# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2340#else
2341# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2342!DIR$ NOINLINE s_compute_species_fraction
2343# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2344#endif
2345# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2346#elif MFC_OpenACC
2347# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2348!$acc routine seq
2349# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2350#elif MFC_OpenMP
2351# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2352
2353# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2354
2355# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2356!$omp declare target device_type(any)
2357# 1123 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2358#endif
2359 type(scalar_field), dimension(sys_size), intent(in) :: q_vf
2360 integer, intent(in) :: k, l, r
2361# 1129 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2362 real(wp), dimension(num_fluids), intent(out) :: alpha_rho_k, alpha_k
2363# 1131 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2364 integer :: i
2365 real(wp) :: alpha_k_sum
2366
2367 if (num_fluids == 1) then
2368 alpha_rho_k(1) = q_vf(eqn_idx%cont%beg)%sf(k, l, r)
2369 if (igr .or. bubbles_euler) then
2370 alpha_k(1) = 1._wp
2371 else
2372 alpha_k(1) = q_vf(eqn_idx%adv%beg)%sf(k, l, r)
2373 end if
2374 else
2375 if (igr) then
2376 do i = 1, num_fluids - 1
2377 alpha_rho_k(i) = q_vf(i)%sf(k, l, r)
2378 alpha_k(i) = q_vf(eqn_idx%adv%beg + i - 1)%sf(k, l, r)
2379 end do
2380 alpha_rho_k(num_fluids) = q_vf(num_fluids)%sf(k, l, r)
2381 alpha_k(num_fluids) = 1._wp - sum(alpha_k(1:num_fluids - 1))
2382 else
2383 do i = 1, num_fluids
2384 alpha_rho_k(i) = q_vf(i)%sf(k, l, r)
2385 alpha_k(i) = q_vf(eqn_idx%adv%beg + i - 1)%sf(k, l, r)
2386 end do
2387 end if
2388 end if
2389
2390 if (mpp_lim) then
2391 alpha_k_sum = 0._wp
2392 do i = 1, num_fluids
2393 alpha_rho_k(i) = max(0._wp, alpha_rho_k(i))
2394 alpha_k(i) = min(max(0._wp, alpha_k(i)), 1._wp)
2395 alpha_k_sum = alpha_k_sum + alpha_k(i)
2396 end do
2397 alpha_k = alpha_k/max(alpha_k_sum, 1.e-16_wp)
2398 end if
2399
2400 if (num_fluids == 1 .and. bubbles_euler) alpha_k(1) = q_vf(eqn_idx%adv%beg)%sf(k, l, r)
2401
2402 end subroutine s_compute_species_fraction
2403
2404 !> Deallocate fluid property arrays and post-processing fields allocated during module initialization.
2405 impure subroutine s_finalize_variables_conversion_module()
2406
2407 if (allocated(rho_sf)) deallocate (rho_sf, gamma_sf, pi_inf_sf)
2408
2409#ifdef MFC_DEBUG
2410# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2411 block
2412# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2413 use iso_fortran_env, only: output_unit
2414# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2415
2416# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2417 print *, 'm_variables_conversion.fpp:1176: ', '@:DEALLOCATE(gammas, isentrope_n, pi_infs, isentrope_B, cvs, qvs, qvps, Gs_vc)'
2418# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2419
2420# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2421 call flush (output_unit)
2422# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2423 end block
2424# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2425#endif
2426# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2427
2428# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2429#if defined(MFC_OpenACC)
2430# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2431!$acc exit data delete(gammas, isentrope_n, pi_infs, isentrope_B, cvs, qvs, qvps, Gs_vc)
2432# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2433#elif defined(MFC_OpenMP)
2434# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2435!$omp target exit data map(release:gammas, isentrope_n, pi_infs, isentrope_B, cvs, qvs, qvps, Gs_vc)
2436# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2437#endif
2438# 1176 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2439 deallocate (gammas, isentrope_n, pi_infs, isentrope_b, cvs, qvs, qvps, gs_vc)
2440 if (allocated(bubrs_vc)) then
2441#ifdef MFC_DEBUG
2442# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2443 block
2444# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2445 use iso_fortran_env, only: output_unit
2446# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2447
2448# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2449 print *, 'm_variables_conversion.fpp:1178: ', '@:DEALLOCATE(bubrs_vc)'
2450# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2451
2452# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2453 call flush (output_unit)
2454# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2455 end block
2456# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2457#endif
2458# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2459
2460# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2461#if defined(MFC_OpenACC)
2462# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2463!$acc exit data delete(bubrs_vc)
2464# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2465#elif defined(MFC_OpenMP)
2466# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2467!$omp target exit data map(release:bubrs_vc)
2468# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2469#endif
2470# 1178 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2471 deallocate (bubrs_vc)
2472 end if
2473 if (allocated(res_vc)) then
2474#ifdef MFC_DEBUG
2475# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2476 block
2477# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2478 use iso_fortran_env, only: output_unit
2479# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2480
2481# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2482 print *, 'm_variables_conversion.fpp:1181: ', '@:DEALLOCATE(Res_vc)'
2483# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2484
2485# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2486 call flush (output_unit)
2487# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2488 end block
2489# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2490#endif
2491# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2492
2493# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2494#if defined(MFC_OpenACC)
2495# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2496!$acc exit data delete(Res_vc)
2497# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2498#elif defined(MFC_OpenMP)
2499# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2500!$omp target exit data map(release:Res_vc)
2501# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2502#endif
2503# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2504 deallocate (res_vc)
2505 end if
2506
2507 end subroutine s_finalize_variables_conversion_module
2508
2509 !> Mixture coefficients of one state. Under bubbles_euler with num_fluids == 1 the sole advection slot aliases the void fraction
2510 !! (eqn_idx%alf == eqn_idx%adv%end), so alpha is not a composition there and the coefficients are the liquid's. Clipping stays
2511 !! with callers; it differs between solvers and cannot coincide with that case, as mpp_lim requires num_fluids > 1.
2512 subroutine s_compute_mixture_coefficients(alpha_rho_K, alpha_K, rho_K, gamma_K, pi_inf_K, qv_K)
2513
2514
2515# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2516#ifdef _CRAYFTN
2517# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2518#if MFC_OpenACC
2519# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2520!$acc routine seq
2521# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2522#elif MFC_OpenMP
2523# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2524
2525# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2526
2527# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2528!$omp declare target device_type(any)
2529# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2530#else
2531# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2532!DIR$ INLINEALWAYS s_compute_mixture_coefficients
2533# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2534#endif
2535# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2536#elif MFC_OpenACC
2537# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2538!$acc routine seq
2539# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2540#elif MFC_OpenMP
2541# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2542
2543# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2544
2545# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2546!$omp declare target device_type(any)
2547# 1191 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2548#endif
2549
2550# 1196 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2551 real(wp), dimension(num_fluids), intent(in) :: alpha_rho_k, alpha_k
2552# 1198 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2553 real(wp), intent(out) :: rho_k, gamma_k, pi_inf_k, qv_k
2554 integer :: i !< Loop iterator over fluids
2555
2556 ! The bubbly closure is written for one carrier liquid, which keeps its own coefficients
2557 ! undiluted: Gamma_l*p_l = (E - rho|u|^2/2)/(1 - alf) - Pi_inf_l, the void entering only through
2558 ! the (1 - alf) that s_compute_pressure applies. There is nothing to sum - the last advection
2559 ! slot is the void, not a material - and the checker holds num_fluids <= 2 here.
2560 if (bubbles_euler) then
2561 rho_k = alpha_rho_k(1)
2562 gamma_k = gammas(1)
2563 pi_inf_k = pi_infs(1)
2564 ! Energy per unit volume, as below: alpha_rho_K(1) is the liquid partial density
2565 qv_k = alpha_rho_k(1)*qvs(1)
2566 else
2567 rho_k = 0._wp
2568 gamma_k = 0._wp
2569 pi_inf_k = 0._wp
2570 qv_k = 0._wp
2571
2572
2573# 1217 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2574#if defined(MFC_OpenACC)
2575# 1217 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2576!$acc loop seq
2577# 1217 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2578#elif defined(MFC_OpenMP)
2579# 1217 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2580
2581# 1217 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2582#endif
2583 do i = 1, num_fluids
2584 rho_k = rho_k + alpha_rho_k(i)
2585 gamma_k = gamma_k + alpha_k(i)*gammas(i)
2586 pi_inf_k = pi_inf_k + alpha_k(i)*pi_infs(i)
2587 qv_k = qv_k + alpha_rho_k(i)*qvs(i)
2588 end do
2589 end if
2590
2591 end subroutine s_compute_mixture_coefficients
2592
2593 !> Time derivative of the mixture coefficients, mirroring s_compute_mixture_coefficients.
2594 subroutine s_compute_mixture_coefficients_dt(dalpha_rho_dt, dadv_dt, drho_dt, dgamma_dt, dpi_inf_dt, dqv_dt)
2595
2596
2597# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2598#ifdef _CRAYFTN
2599# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2600#if MFC_OpenACC
2601# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2602!$acc routine seq
2603# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2604#elif MFC_OpenMP
2605# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2606
2607# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2608
2609# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2610!$omp declare target device_type(any)
2611# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2612#else
2613# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2614!DIR$ INLINEALWAYS s_compute_mixture_coefficients_dt
2615# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2616#endif
2617# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2618#elif MFC_OpenACC
2619# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2620!$acc routine seq
2621# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2622#elif MFC_OpenMP
2623# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2624
2625# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2626
2627# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2628!$omp declare target device_type(any)
2629# 1231 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2630#endif
2631
2632# 1236 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2633 real(wp), dimension(num_fluids), intent(in) :: dalpha_rho_dt, dadv_dt
2634# 1238 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2635 real(wp), intent(out) :: drho_dt, dgamma_dt, dpi_inf_dt, dqv_dt
2636 integer :: i !< Loop iterator over fluids
2637
2638 dgamma_dt = 0._wp
2639 dpi_inf_dt = 0._wp
2640 dqv_dt = 0._wp
2641
2642 if (num_fluids == 1 .and. bubbles_euler) then
2643 ! Fluid 1's coefficients are constants here, so only rho varies.
2644 drho_dt = dalpha_rho_dt(1)
2645 else
2646 drho_dt = 0._wp
2647
2648
2649# 1251 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2650#if defined(MFC_OpenACC)
2651# 1251 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2652!$acc loop seq
2653# 1251 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2654#elif defined(MFC_OpenMP)
2655# 1251 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2656
2657# 1251 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2658#endif
2659 do i = 1, num_fluids
2660 drho_dt = drho_dt + dalpha_rho_dt(i)
2661 dgamma_dt = dgamma_dt + dadv_dt(i)*gammas(i)
2662 dpi_inf_dt = dpi_inf_dt + dadv_dt(i)*pi_infs(i)
2663 dqv_dt = dqv_dt + dalpha_rho_dt(i)*qvs(i)
2664 end do
2665 end if
2666
2667 end subroutine s_compute_mixture_coefficients_dt
2668
2669 !> Total energy per unit volume, thermodynamic terms only. Callers add magnetic and elastic energy, which are not
2670 !! equation-of-state terms. The chemistry and relativistic branches use a different relation and stay open-coded.
2671 subroutine s_compute_energy(pres, alpha_rho_K, alpha_K, vel_sum, E)
2672
2673
2674# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2675#ifdef _CRAYFTN
2676# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2677#if MFC_OpenACC
2678# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2679!$acc routine seq
2680# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2681#elif MFC_OpenMP
2682# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2683
2684# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2685
2686# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2687!$omp declare target device_type(any)
2688# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2689#else
2690# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2691!DIR$ INLINEALWAYS s_compute_energy
2692# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2693#endif
2694# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2695#elif MFC_OpenACC
2696# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2697!$acc routine seq
2698# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2699#elif MFC_OpenMP
2700# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2701
2702# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2703
2704# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2705!$omp declare target device_type(any)
2706# 1266 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2707#endif
2708
2709# 1271 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2710 real(wp), dimension(num_fluids), intent(in) :: alpha_rho_k, alpha_k
2711# 1273 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2712 real(wp), intent(in) :: pres, vel_sum
2713 real(wp), intent(out) :: e
2714 real(wp) :: rho, gamma, pi_inf, qv
2715
2716 call s_compute_mixture_coefficients(alpha_rho_k, alpha_k, rho, gamma, pi_inf, qv)
2717
2718 ! E = dyn_p + (1 - alf)(gamma p + pi_inf) + qv. Only the liquid's internal energy is diluted;
2719 ! qv is already an energy density.
2720 e = gamma*pres + pi_inf
2721 if (bubbles_euler) e = e*(1._wp - alpha_k(num_fluids))
2722 e = e + qv + 5.e-1_wp*rho*vel_sum
2723
2724 end subroutine s_compute_energy
2725
2726 !> Exponent of the stiffened-gas isentrope p + B = const rho**n. Precomputed per fluid as isentrope_n.
2727 function f_isentrope_exponent(gamma) result(n)
2728
2729
2730# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2731#ifdef _CRAYFTN
2732# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2733#if MFC_OpenACC
2734# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2735!$acc routine seq
2736# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2737#elif MFC_OpenMP
2738# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2739
2740# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2741
2742# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2743!$omp declare target device_type(any)
2744# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2745#else
2746# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2747!DIR$ INLINEALWAYS f_isentrope_exponent
2748# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2749#endif
2750# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2751#elif MFC_OpenACC
2752# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2753!$acc routine seq
2754# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2755#elif MFC_OpenMP
2756# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2757
2758# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2759
2760# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2761!$omp declare target device_type(any)
2762# 1290 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2763#endif
2764
2765 real(wp), intent(in) :: gamma
2766 real(wp) :: n
2767
2768 n = 1._wp/gamma + 1._wp
2769
2770 end function f_isentrope_exponent
2771
2772 !> Reference pressure of that isentrope. Precomputed per fluid as isentrope_B.
2773 function f_isentrope_pressure(pi_inf, gamma) result(B)
2774
2775
2776# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2777#ifdef _CRAYFTN
2778# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2779#if MFC_OpenACC
2780# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2781!$acc routine seq
2782# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2783#elif MFC_OpenMP
2784# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2785
2786# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2787
2788# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2789!$omp declare target device_type(any)
2790# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2791#else
2792# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2793!DIR$ INLINEALWAYS f_isentrope_pressure
2794# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2795#endif
2796# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2797#elif MFC_OpenACC
2798# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2799!$acc routine seq
2800# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2801#elif MFC_OpenMP
2802# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2803
2804# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2805
2806# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2807!$omp declare target device_type(any)
2808# 1302 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2809#endif
2810
2811 real(wp), intent(in) :: pi_inf, gamma
2812 real(wp) :: b
2813
2814 b = pi_inf/(1._wp + gamma)
2815
2816 end function f_isentrope_pressure
2817
2818 !> Stiffened-gas thermal law p + B = (n - 1)*cv*rho*T. Pass rho to get T, or T to get rho.
2819 function f_sg_thermal(pres, rho_or_T, n, B, cv) result(T_or_rho)
2820
2821
2822# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2823#ifdef _CRAYFTN
2824# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2825#if MFC_OpenACC
2826# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2827!$acc routine seq
2828# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2829#elif MFC_OpenMP
2830# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2831
2832# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2833
2834# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2835!$omp declare target device_type(any)
2836# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2837#else
2838# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2839!DIR$ INLINEALWAYS f_sg_thermal
2840# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2841#endif
2842# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2843#elif MFC_OpenACC
2844# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2845!$acc routine seq
2846# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2847#elif MFC_OpenMP
2848# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2849
2850# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2851
2852# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2853!$omp declare target device_type(any)
2854# 1314 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2855#endif
2856
2857 real(wp), intent(in) :: pres, rho_or_t, n, b, cv
2858 real(wp) :: t_or_rho
2859
2860 t_or_rho = (pres + b)/((n - 1._wp)*cv*rho_or_t)
2861
2862 end function f_sg_thermal
2863
2864 !> Pressure after isentropic compression from `pres` through density ratio `xi`.
2865 function f_pressure_on_isentrope(pres, xi, n, B) result(p_isen)
2866
2867
2868# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2869#ifdef _CRAYFTN
2870# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2871#if MFC_OpenACC
2872# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2873!$acc routine seq
2874# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2875#elif MFC_OpenMP
2876# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2877
2878# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2879
2880# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2881!$omp declare target device_type(any)
2882# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2883#else
2884# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2885!DIR$ INLINEALWAYS f_pressure_on_isentrope
2886# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2887#endif
2888# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2889#elif MFC_OpenACC
2890# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2891!$acc routine seq
2892# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2893#elif MFC_OpenMP
2894# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2895
2896# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2897
2898# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2899!$omp declare target device_type(any)
2900# 1326 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2901#endif
2902
2903 real(wp), intent(in) :: pres, xi, n, b
2904 real(wp) :: p_isen
2905
2906 p_isen = (pres + b)*xi**n - b
2907
2908 end function f_pressure_on_isentrope
2909
2910 !> Internal energy of one six-equation phase: volume-fraction-weighted stiffened-gas energy plus the heat of formation its
2911 !! partial density carries. No kinetic term - that belongs to the mixture, not a phase.
2912 function f_phase_internal_energy(pres, alpha, alpha_rho, gamma, pi_inf, qv) result(e_phase)
2913
2914
2915# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2916#ifdef _CRAYFTN
2917# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2918#if MFC_OpenACC
2919# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2920!$acc routine seq
2921# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2922#elif MFC_OpenMP
2923# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2924
2925# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2926
2927# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2928!$omp declare target device_type(any)
2929# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2930#else
2931# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2932!DIR$ INLINEALWAYS f_phase_internal_energy
2933# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2934#endif
2935# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2936#elif MFC_OpenACC
2937# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2938!$acc routine seq
2939# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2940#elif MFC_OpenMP
2941# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2942
2943# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2944
2945# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2946!$omp declare target device_type(any)
2947# 1339 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2948#endif
2949
2950 real(wp), intent(in) :: pres, alpha, alpha_rho, gamma, pi_inf, qv
2951 real(wp) :: e_phase
2952
2953 e_phase = alpha*(gamma*pres + pi_inf) + alpha_rho*qv
2954
2955 end function f_phase_internal_energy
2956
2957 !> Elastic strain energy of one stress component, doubled for a shear component: the tensor stores it once, the energy counts
2958 !! both off-diagonal entries. Zero without a shear modulus.
2959 function f_elastic_energy(tau, G, is_shear) result(dE)
2960
2961
2962# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2963#ifdef _CRAYFTN
2964# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2965#if MFC_OpenACC
2966# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2967!$acc routine seq
2968# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2969#elif MFC_OpenMP
2970# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2971
2972# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2973
2974# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2975!$omp declare target device_type(any)
2976# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2977#else
2978# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2979!DIR$ INLINEALWAYS f_elastic_energy
2980# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2981#endif
2982# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2983#elif MFC_OpenACC
2984# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2985!$acc routine seq
2986# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2987#elif MFC_OpenMP
2988# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2989
2990# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2991
2992# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2993!$omp declare target device_type(any)
2994# 1352 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2995#endif
2996
2997 real(wp), intent(in) :: tau, g
2998 logical, intent(in) :: is_shear
2999 real(wp) :: de
3000
3001 de = 0._wp
3002 if (g > verysmall) then
3003 de = (tau*tau)/max(4._wp*g, verysmall)
3004 if (is_shear) de = de + (tau*tau)/max(4._wp*g, verysmall)
3005 end if
3006
3007 end function f_elastic_energy
3008
3009 !> Hypoelastic strain energy at one cell, summed over the stress components.
3010 function f_hypoelastic_energy(q_cons_vf, j, k, l, rho, G) result(E_e)
3011
3012 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
3013 integer, intent(in) :: j, k, l
3014 real(wp), intent(in) :: rho, g
3015 real(wp) :: e_e
3016 integer :: s
3017
3018 e_e = 0._wp
3019 do s = eqn_idx%stress%beg, eqn_idx%stress%end
3020 e_e = e_e + f_elastic_energy(real(q_cons_vf(s)%sf(j, k, l), wp)/rho, g, any(s == shear_indices))
3021 end do
3022
3023 end function f_hypoelastic_energy
3024
3025 !> Pressure of a stiffened gas from its internal energy density - the inverse of s_compute_energy. Callers subtract the kinetic,
3026 !! magnetic and elastic energy first; none of those are equation-of-state terms.
3027 function f_pressure(e_int, gamma, pi_inf, qv) result(pres)
3028
3029
3030# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3031#ifdef _CRAYFTN
3032# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3033#if MFC_OpenACC
3034# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3035!$acc routine seq
3036# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3037#elif MFC_OpenMP
3038# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3039
3040# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3041
3042# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3043!$omp declare target device_type(any)
3044# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3045#else
3046# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3047!DIR$ INLINEALWAYS f_pressure
3048# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3049#endif
3050# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3051#elif MFC_OpenACC
3052# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3053!$acc routine seq
3054# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3055#elif MFC_OpenMP
3056# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3057
3058# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3059
3060# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3061!$omp declare target device_type(any)
3062# 1386 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3063#endif
3064
3065 real(wp), intent(in) :: e_int, gamma, pi_inf, qv
3066 real(wp) :: pres
3067
3068 pres = (e_int - pi_inf - qv)/gamma
3069
3070 end function f_pressure
3071
3072 !> Isentropic bulk modulus. Takes coefficients rather than a fluid index, so a mixture - whose effective gamma and pi_inf come
3073 !! from s_compute_mixture_coefficients - is the same call as a single fluid. Elastic callers add their own shear term.
3074 function f_bulk_modulus(pres, gamma, pi_inf) result(blkmod)
3075
3076
3077# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3078#ifdef _CRAYFTN
3079# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3080#if MFC_OpenACC
3081# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3082!$acc routine seq
3083# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3084#elif MFC_OpenMP
3085# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3086
3087# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3088
3089# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3090!$omp declare target device_type(any)
3091# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3092#else
3093# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3094!DIR$ INLINEALWAYS f_bulk_modulus
3095# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3096#endif
3097# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3098#elif MFC_OpenACC
3099# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3100!$acc routine seq
3101# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3102#elif MFC_OpenMP
3103# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3104
3105# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3106
3107# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3108!$omp declare target device_type(any)
3109# 1399 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3110#endif
3111
3112 real(wp), intent(in) :: pres, gamma, pi_inf
3113 real(wp) :: blkmod
3114
3115 blkmod = ((gamma + 1._wp)*pres + pi_inf)/gamma
3116
3117 end function f_bulk_modulus
3118
3119 !> Relativistic specific enthalpy, h = 1 + (Gamma + 1)p/rho. Ideal gas only: the stiffness does not appear, so a fluid with a
3120 !! nonzero pi_inf is not represented here (the validator refuses that combination).
3121 function f_relativistic_enthalpy(pres, rho, gamma) result(H)
3122
3123
3124# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3125#ifdef _CRAYFTN
3126# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3127#if MFC_OpenACC
3128# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3129!$acc routine seq
3130# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3131#elif MFC_OpenMP
3132# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3133
3134# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3135
3136# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3137!$omp declare target device_type(any)
3138# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3139#else
3140# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3141!DIR$ INLINEALWAYS f_relativistic_enthalpy
3142# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3143#endif
3144# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3145#elif MFC_OpenACC
3146# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3147!$acc routine seq
3148# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3149#elif MFC_OpenMP
3150# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3151
3152# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3153
3154# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3155!$omp declare target device_type(any)
3156# 1412 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3157#endif
3158
3159 real(wp), intent(in) :: pres, rho, gamma
3160 real(wp) :: h
3161
3162 h = 1._wp + (gamma + 1._wp)*pres/rho
3163
3164 end function f_relativistic_enthalpy
3165
3166 !> Speed of sound of a thermodynamic state. Enthalpy is not an argument: for a real state H, |u|^2 and qv all cancel out of c^2
3167 !! = ((Gamma + 1)p + Pi)/(Gamma rho). Averaged states, whose enthalpy is a free input, use the _avg variant.
3168 subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, adv, c)
3169
3170
3171# 1425 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3172#if MFC_OpenACC
3173# 1425 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3174!$acc routine seq
3175# 1425 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3176#elif MFC_OpenMP
3177# 1425 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3178
3179# 1425 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3180
3181# 1425 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3182!$omp declare target device_type(any)
3183# 1425 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3184#endif
3185
3186 real(wp), intent(in) :: pres, rho, gamma, pi_inf
3187# 1431 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3188 real(wp), dimension(num_fluids), intent(in) :: adv
3189# 1433 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3190 real(wp), intent(out) :: c
3191 real(wp) :: alf !< Subgrid void fraction; dilute by construction
3192 integer :: q
3193
3194 if (chemistry) then ! Reacting mixture sound speed
3195 c = sqrt((1.0_wp + 1.0_wp/gamma)*pres/rho)
3196 else if (relativity) then ! Relativistic sound speed, whose enthalpy is 1 + (Gamma + 1)p/rho
3197 c = sqrt((1._wp + 1._wp/gamma)*pres/rho/f_relativistic_enthalpy(pres, rho, gamma))
3198 else
3199 ! Every case below is a bulk modulus over a density. The equation of state enters
3200 ! only through f_bulk_modulus; the cases differ in how the phases are mixed.
3201 if (alt_soundspeed) then ! Wood's law: volume-weighted harmonic mean
3202 c = 1._wp/(rho*(adv(1)/f_bulk_modulus(pres, gammas(1), pi_infs(1)) + adv(2)/f_bulk_modulus(pres, gammas(2), &
3203 & pi_infs(2))))
3204 else if (model_eqns == model_eqns_6eq) then ! volume-weighted arithmetic mean
3205 c = 0._wp
3206
3207# 1449 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3208#if defined(MFC_OpenACC)
3209# 1449 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3210!$acc loop seq
3211# 1449 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3212#elif defined(MFC_OpenMP)
3213# 1449 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3214
3215# 1449 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3216#endif
3217 do q = 1, num_fluids
3218 c = c + adv(q)*f_bulk_modulus(pres, gammas(q), pi_infs(q))
3219 end do
3220 c = c/rho
3221 else ! the mixture coefficients already carry the mixing
3222 c = f_bulk_modulus(pres, gamma, pi_inf)/rho
3223
3224 ! Subgrid bubbles: c = c_l/(1 - alf), the carrier-liquid speed with an O(alf) void
3225 ! correction. alf is dilute by construction; near one means a wrong index or an
3226 ! out-of-regime case, which the toolchain warns about at case load (#1793).
3227 if (model_eqns == model_eqns_5eq .and. bubbles_euler .and. .not. (mpp_lim .and. num_fluids > 1)) then
3228 alf = adv(num_fluids)
3229 c = c/(1._wp - alf)
3230 end if
3231 end if
3232
3233 if (mixture_err .and. c < 0._wp) then
3234 c = 100._wp*sgm_eps
3235 else
3236 c = sqrt(c)
3237 end if
3238 end if
3239
3240 end subroutine s_compute_speed_of_sound
3241
3242 !> Speed of sound of an interface-averaged state. An average of two states is not a state - its enthalpy is not the one its
3243 !! pressure and density imply - so the caller supplies H, |u|^2 and qv. Only the enthalpy-reading branches differ from
3244 !! s_compute_speed_of_sound; keep the condition below in step with the branch list there.
3245 subroutine s_compute_speed_of_sound_avg(pres, rho, gamma, pi_inf, qv, vel_sum, H, c_c, adv, c)
3246
3247
3248# 1480 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3249#if MFC_OpenACC
3250# 1480 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3251!$acc routine seq
3252# 1480 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3253#elif MFC_OpenMP
3254# 1480 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3255
3256# 1480 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3257
3258# 1480 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3259!$omp declare target device_type(any)
3260# 1480 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3261#endif
3262
3263 real(wp), intent(in) :: pres, rho, gamma, pi_inf, qv, vel_sum, h, c_c
3264# 1486 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3265 real(wp), dimension(num_fluids), intent(in) :: adv
3266# 1488 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3267 real(wp), intent(out) :: c
3268
3269 if (chemistry) then ! Reacting mixture sound speed
3270 if (avg_state == avg_state_roe .and. abs(c_c) > verysmall) then
3271 c = sqrt(c_c - (gamma - 1.0_wp)*(vel_sum - h))
3272 else
3273 call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, adv, c)
3274 end if
3275 else if (relativity) then ! Relativistic sound speed
3276 c = sqrt((1._wp + 1._wp/gamma)*pres/rho/h)
3277 else if (alt_soundspeed .or. model_eqns == model_eqns_6eq .or. (model_eqns == model_eqns_5eq .and. bubbles_euler)) then
3278 call s_compute_speed_of_sound(pres, rho, gamma, pi_inf, adv, c)
3279 else ! Stiffened-gas mixture, the one branch where the averaged enthalpy survives
3280 c = (h - 5.e-1*vel_sum - qv/rho)/gamma
3281
3282 if (mixture_err .and. c < 0._wp) then
3283 c = 100._wp*sgm_eps
3284 else
3285 c = sqrt(c)
3286 end if
3287 end if
3288
3289 end subroutine s_compute_speed_of_sound_avg
3290
3291 !> Compute the fast magnetosonic wave speed from the sound speed, density, and magnetic field components.
3292 subroutine s_compute_fast_magnetosonic_speed(rho, c, B, norm, c_fast, h)
3293
3294
3295# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3296#ifdef _CRAYFTN
3297# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3298#if MFC_OpenACC
3299# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3300!$acc routine seq
3301# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3302#elif MFC_OpenMP
3303# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3304
3305# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3306
3307# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3308!$omp declare target device_type(any)
3309# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3310#else
3311# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3312!DIR$ NOINLINE s_compute_fast_magnetosonic_speed
3313# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3314#endif
3315# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3316#elif MFC_OpenACC
3317# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3318!$acc routine seq
3319# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3320#elif MFC_OpenMP
3321# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3322
3323# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3324
3325# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3326!$omp declare target device_type(any)
3327# 1515 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
3328#endif
3329
3330 real(wp), intent(in) :: b(3), rho, c
3331 real(wp), intent(in) :: h !< only used for relativity
3332 real(wp), intent(out) :: c_fast
3333 integer, intent(in) :: norm
3334 real(wp) :: b2, term, disc
3335
3336 b2 = sum(b**2)
3337
3338 if (.not. relativity) then
3339 term = c**2 + b2/rho
3340 disc = term**2 - 4*c**2*(b(norm)**2/rho)
3341 else
3342 ! Note: this is approximation for the non-relatisitic limit; accurate solution requires solving a quartic equation
3343 term = (c**2*(b(norm)**2 + rho*h) + b2)/(rho*h + b2)
3344 disc = term**2 - 4*c**2*b(norm)**2/(rho*h + b2)
3345 end if
3346
3347#ifdef MFC_DEBUG
3348 if (disc < 0._wp) then
3349 print *, 'rho, c, Bx, By, Bz, h, term, disc:', rho, c, b(1), b(2), b(3), h, term, disc
3350 ! s_mpi_abort is a host routine and cannot be called from device code
3351 ! (this is a GPU routine); on GPU builds, emit the diagnostic print only.
3352#ifndef MFC_GPU
3353 call s_mpi_abort('Error: negative discriminant in s_compute_fast_magnetosonic_speed')
3354#endif
3355 end if
3356#endif
3357
3358 c_fast = sqrt(0.5_wp*(term + sqrt(disc)))
3359
3360 end subroutine s_compute_fast_magnetosonic_speed
3361
3362end module m_variables_conversion
q_cons_vf
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
Definition m_phase_change.fpp.f90:993
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:995
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:995
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:995
m_constants
Compile-time constant parameters: default values, tolerances, and physical constants.
Definition m_constants.fpp.f90:7
m_constants::model_eqns_5eq
integer, parameter model_eqns_5eq
Definition m_constants.fpp.f90:142
m_constants::avg_state_roe
integer, parameter avg_state_roe
Definition m_constants.fpp.f90:130
m_constants::riemann_solver_hll
integer, parameter riemann_solver_hll
Definition m_constants.fpp.f90:156
m_constants::riemann_solver_hlld
integer, parameter riemann_solver_hlld
Definition m_constants.fpp.f90:158
m_constants::sgm_eps
real(wp), parameter sgm_eps
Segmentation tolerance.
Definition m_constants.fpp.f90:13
m_constants::dflt_real
real(wp), parameter dflt_real
Default real value.
Definition m_constants.fpp.f90:12
m_constants::model_eqns_6eq
integer, parameter model_eqns_6eq
Definition m_constants.fpp.f90:143
m_constants::model_eqns_gamma_law
integer, parameter model_eqns_gamma_law
Definition m_constants.fpp.f90:141
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:323
m_global_parameters_common
Shared global parameters and equation-index setup for all three executables. Each per-target m_global...
Definition m_global_parameters_common.fpp.f90:335
m_global_parameters_common::surface_tension
logical surface_tension
Definition m_global_parameters_common.fpp.f90:438
m_global_parameters_common::bx0
real(wp) bx0
Definition m_global_parameters_common.fpp.f90:352
m_global_parameters_common::qbmm
logical qbmm
Definition m_global_parameters_common.fpp.f90:423
m_global_parameters_common::igr
logical igr
Definition m_global_parameters_common.fpp.f90:382
m_global_parameters_common::bubbles_lagrange
logical bubbles_lagrange
Definition m_global_parameters_common.fpp.f90:364
m_global_parameters_common::bubbles_euler
logical bubbles_euler
Definition m_global_parameters_common.fpp.f90:363
m_global_parameters_common::cont_damage
logical cont_damage
Definition m_global_parameters_common.fpp.f90:368
m_global_parameters_common::relativity
logical relativity
Definition m_global_parameters_common.fpp.f90:426
m_global_parameters_common::hyper_cleaning
logical hyper_cleaning
Definition m_global_parameters_common.fpp.f90:379
m_global_parameters_common::fluid_pp
type(physical_parameters), dimension(num_fluids_max) fluid_pp
Per-fluid stiffened-gas EOS parameters, Reynolds numbers, and shear modulus.
Definition m_global_parameters_common.fpp.f90:450
m_global_parameters_common::hypoelasticity
logical hypoelasticity
Definition m_global_parameters_common.fpp.f90:380
m_global_parameters_common::eqn_idx
type(eqn_idx_info) eqn_idx
All conserved-variable equation index ranges and scalars.
Definition m_global_parameters_common.fpp.f90:476
m_global_parameters_common::chemistry
logical, parameter chemistry
Definition m_global_parameters_common.fpp.f90:481
m_global_parameters_common::num_fluids
integer num_fluids
Definition m_global_parameters_common.fpp.f90:403
m_global_parameters_common::nb
integer nb
Definition m_global_parameters_common.fpp.f90:401
m_global_parameters_common::adv_n
logical adv_n
Definition m_global_parameters_common.fpp.f90:360
m_global_parameters_common::mhd
logical mhd
Definition m_global_parameters_common.fpp.f90:388
m_global_parameters_common::n
integer n
Definition m_global_parameters_common.fpp.f90:398
m_global_parameters_common::shear_indices
integer, dimension(3) shear_indices
Indices of the stress components that represent shear stress.
Definition m_global_parameters_common.fpp.f90:487
m_global_parameters
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
Definition m_global_parameters.fpp.f90:19
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:323
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:334
m_mpi_proxy
Broadcasts user inputs and decomposes the domain across MPI ranks for pre-processing.
Definition m_mpi_proxy.fpp.f90:7
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:334
m_variables_conversion::f_bulk_modulus
real(wp) function, public f_bulk_modulus(pres, gamma, pi_inf)
Isentropic bulk modulus. Takes coefficients rather than a fluid index, so a mixture - whose effective...
Definition m_variables_conversion.fpp.f90:3075
m_variables_conversion::f_elastic_energy
real(wp) function, public f_elastic_energy(tau, g, is_shear)
Elastic strain energy of one stress component, doubled for a shear component: the tensor stores it on...
Definition m_variables_conversion.fpp.f90:2960
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:2323
m_variables_conversion::s_compute_speed_of_sound_avg
subroutine, public s_compute_speed_of_sound_avg(pres, rho, gamma, pi_inf, qv, vel_sum, h, c_c, adv, c)
Speed of sound of an interface-averaged state. An average of two states is not a state - its enthalpy...
Definition m_variables_conversion.fpp.f90:3246
m_variables_conversion::res_vc
real(wp), dimension(:,:), allocatable res_vc
Definition m_variables_conversion.fpp.f90:361
m_variables_conversion::is3e
integer is3e
Definition m_variables_conversion.fpp.f90:374
m_variables_conversion::s_finalize_variables_conversion_module
impure subroutine, public s_finalize_variables_conversion_module()
Deallocate fluid property arrays and post-processing fields allocated during module initialization.
Definition m_variables_conversion.fpp.f90:2406
m_variables_conversion::s_compute_mixture_coefficients
subroutine, public s_compute_mixture_coefficients(alpha_rho_k, alpha_k, rho_k, gamma_k, pi_inf_k, qv_k)
Mixture coefficients of one state. Under bubbles_euler with num_fluids == 1 the sole advection slot a...
Definition m_variables_conversion.fpp.f90:2513
m_variables_conversion::f_hypoelastic_energy
real(wp) function, public f_hypoelastic_energy(q_cons_vf, j, k, l, rho, g)
Hypoelastic strain energy at one cell, summed over the stress components.
Definition m_variables_conversion.fpp.f90:3011
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:1131
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:1170
m_variables_conversion::s_compute_mixture_coefficients_dt
subroutine, public s_compute_mixture_coefficients_dt(dalpha_rho_dt, dadv_dt, drho_dt, dgamma_dt, dpi_inf_dt, dqv_dt)
Time derivative of the mixture coefficients, mirroring s_compute_mixture_coefficients.
Definition m_variables_conversion.fpp.f90:2595
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:1733
m_variables_conversion::is3b
integer is3b
Definition m_variables_conversion.fpp.f90:374
m_variables_conversion::f_sg_thermal
real(wp) function, public f_sg_thermal(pres, rho_or_t, n, b, cv)
Stiffened-gas thermal law p + B = (n - 1)*cv*rho*T. Pass rho to get T, or T to get rho.
Definition m_variables_conversion.fpp.f90:2820
m_variables_conversion::f_pressure_on_isentrope
real(wp) function, public f_pressure_on_isentrope(pres, xi, n, b)
Pressure after isentropic compression from pres through density ratio xi.
Definition m_variables_conversion.fpp.f90:2866
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:1216
m_variables_conversion::f_relativistic_enthalpy
real(wp) function, public f_relativistic_enthalpy(pres, rho, gamma)
Relativistic specific enthalpy, h = 1 + (Gamma + 1)p/rho. Ideal gas only: the stiffness does not appe...
Definition m_variables_conversion.fpp.f90:3122
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:535
m_variables_conversion::s_compute_pressure
subroutine, public s_compute_pressure(energy, alf, dyn_p, pi_inf, gamma, rho, qv, rhoyks, pres, t, e_e_in, pres_mag)
Compute the pressure from the appropriate equation of state.
Definition m_variables_conversion.fpp.f90:429
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:507
m_variables_conversion::pi_inf_sf
real(wp), dimension(:,:,:), allocatable, public pi_inf_sf
Scalar liquid stiffness function.
Definition m_variables_conversion.fpp.f90:404
m_variables_conversion::s_compute_energy
subroutine, public s_compute_energy(pres, alpha_rho_k, alpha_k, vel_sum, e)
Total energy per unit volume, thermodynamic terms only. Callers add magnetic and elastic energy,...
Definition m_variables_conversion.fpp.f90:2672
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, dir_idx_in, dir_flg_in, hll_u_interface_in)
Convert primitive variables to Eulerian flux variables.
Definition m_variables_conversion.fpp.f90:1964
m_variables_conversion::s_compute_fast_magnetosonic_speed
subroutine, public 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:3293
m_variables_conversion::s_compute_speed_of_sound
subroutine, public s_compute_speed_of_sound(pres, rho, gamma, pi_inf, adv, c)
Speed of sound of a thermodynamic state. Enthalpy is not an argument: for a real state H,...
Definition m_variables_conversion.fpp.f90:3169
m_variables_conversion::gamma_sf
real(wp), dimension(:,:,:), allocatable, public gamma_sf
Scalar sp. heat ratio function.
Definition m_variables_conversion.fpp.f90:403
m_variables_conversion::f_isentrope_exponent
real(wp) function, public f_isentrope_exponent(gamma)
Exponent of the stiffened-gas isentrope p + B = const rho**n. Precomputed per fluid as isentrope_n.
Definition m_variables_conversion.fpp.f90:2728
m_variables_conversion::s_initialize_variables_conversion_module
impure subroutine, public s_initialize_variables_conversion_module(store_mixture_fields, enforce_density_floor, preserve_qbmm_number, lagrange_beta_index)
Initialize the variables conversion module.
Definition m_variables_conversion.fpp.f90:660
m_variables_conversion::is2e
integer is2e
Definition m_variables_conversion.fpp.f90:374
m_variables_conversion::rho_sf
real(wp), dimension(:,:,:), allocatable, public rho_sf
Scalar density function.
Definition m_variables_conversion.fpp.f90:402
m_variables_conversion::f_isentrope_pressure
real(wp) function, public f_isentrope_pressure(pi_inf, gamma)
Reference pressure of that isentrope. Precomputed per fluid as isentrope_B.
Definition m_variables_conversion.fpp.f90:2774
m_variables_conversion::is1b
integer is1b
Definition m_variables_conversion.fpp.f90:374
m_variables_conversion::bubrs_vc
integer, dimension(:), allocatable bubrs_vc
Definition m_variables_conversion.fpp.f90:360
m_variables_conversion::gs_vc
real(wp), dimension(:), allocatable gs_vc
Definition m_variables_conversion.fpp.f90:359
m_variables_conversion::f_phase_internal_energy
real(wp) function, public f_phase_internal_energy(pres, alpha, alpha_rho, gamma, pi_inf, qv)
Internal energy of one six-equation phase: volume-fraction-weighted stiffened-gas energy plus the hea...
Definition m_variables_conversion.fpp.f90:2913
m_variables_conversion::s_convert_species_to_mixture_variables_kernel
subroutine, public s_convert_species_to_mixture_variables_kernel(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, alpha_rho_k, re_k, g_k, g)
Host- and device-callable conversion kernel for species and mixture variables.
Definition m_variables_conversion.fpp.f90:566
m_variables_conversion::enforce_density_floor_vc
logical enforce_density_floor_vc
Definition m_variables_conversion.fpp.f90:387
m_variables_conversion::is1e
integer is1e
Definition m_variables_conversion.fpp.f90:374
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:411
m_variables_conversion::lagrange_beta_index_vc
integer lagrange_beta_index_vc
Definition m_variables_conversion.fpp.f90:389
m_variables_conversion::f_pressure
real(wp) function, public f_pressure(e_int, gamma, pi_inf, qv)
Pressure of a stiffened gas from its internal energy density - the inverse of s_compute_energy....
Definition m_variables_conversion.fpp.f90:3028
m_variables_conversion::is2b
integer is2b
Definition m_variables_conversion.fpp.f90:374
m_variables_conversion::preserve_qbmm_number_vc
logical preserve_qbmm_number_vc
Definition m_variables_conversion.fpp.f90:388
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:337