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