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 (model_eqns == model_eqns_6eq) then
1583
1584# 674 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1585#if defined(MFC_OpenACC)
1586# 674 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1587!$acc loop seq
1588# 674 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1589#elif defined(MFC_OpenMP)
1590# 674 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1591
1592# 674 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1593#endif
1594# 675 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1595 do i = eqn_idx%int_en%beg, eqn_idx%int_en%end
1596 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)
1597 end do
1598 end if
1599
1600 if (surface_tension) then
1601 qk_prim_vf(eqn_idx%c)%sf(j, k, l) = qk_cons_vf(eqn_idx%c)%sf(j, k, l)
1602 end if
1603
1604 if (hyper_cleaning) qk_prim_vf(eqn_idx%psi)%sf(j, k, l) = qk_cons_vf(eqn_idx%psi)%sf(j, k, l)
1605 if (bubbles_lagrange .and. lagrange_beta_index_vc > 0) then
1606 qk_prim_vf(lagrange_beta_index_vc)%sf(j, k, l) = qk_cons_vf(lagrange_beta_index_vc)%sf(j, k, l)
1607 end if
1608 end do
1609 end do
1610 end do
1611
1612# 691 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1613#if defined(MFC_OpenACC)
1614# 691 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1615!$acc end parallel loop
1616# 691 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1617#elif defined(MFC_OpenMP)
1618# 691 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1619
1620# 691 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1621!$omp end target teams loop
1622# 691 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1623#endif
1624# 692 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1625
1626 end subroutine s_convert_conservative_to_primitive_variables
1627
1628 !> Convert primitives (rho, u, p, alpha) to conserved variables (rho*alpha, rho*u, E, alpha).
1629 impure subroutine s_convert_primitive_to_conservative_variables(q_prim_vf, q_cons_vf)
1630
1631 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1632 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
1633
1634 ! Density, specific heat ratio function, liquid stiffness function and dynamic pressure, as defined in the incompressible
1635 ! flow sense, respectively
1636 real(wp) :: rho
1637 real(wp) :: gamma
1638 real(wp) :: pi_inf
1639 real(wp) :: pres_i, alpha_i, alpha_rho_i, e_i
1640 real(wp) :: qv
1641 real(wp) :: dyn_pres
1642 real(wp) :: nbub, r3tmp
1643 real(wp), dimension(nb) :: rtmp
1644 real(wp) :: g
1645 real(wp) :: solid_partial_density
1646 real(wp), dimension(2) :: re_k
1647 integer :: i, j, k, l !< Generic loop iterators
1648 real(wp), dimension(num_species) :: ys
1649 real(wp) :: e_mix, mix_mol_weight, t
1650 real(wp) :: pres_mag
1651 real(wp) :: ga !< Lorentz factor (gamma in relativity)
1652 real(wp) :: h !< relativistic enthalpy
1653 real(wp) :: v2 !< Square of the velocity magnitude
1654 real(wp) :: b2 !< Square of the magnetic field magnitude
1655 real(wp) :: vdotb !< Dot product of the velocity and magnetic field vectors
1656 real(wp) :: b(3) !< Magnetic field components
1657
1658 pres_mag = 0._wp
1659
1660 g = 0._wp
1661
1662 ! Converting the primitive variables to the conservative variables
1663 do l = 0, p
1664 do k = 0, n
1665 do j = 0, m
1666 ! Obtaining the density, specific heat ratio function and the liquid stiffness function, respectively
1667 call s_convert_to_mixture_variables(q_prim_vf, j, k, l, rho, gamma, pi_inf, qv, re_k, g, fluid_pp(:)%G)
1668
1669 if (.not. igr .or. num_fluids > 1) then
1670 ! Transferring the advection equation(s) variable(s)
1671 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1672 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
1673 end do
1674 end if
1675
1676 if (relativity) then
1677 if (n == 0) then
1678 b(1) = bx0
1679 b(2) = q_prim_vf(eqn_idx%B%beg)%sf(j, k, l)
1680 b(3) = q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l)
1681 else
1682 b(1) = q_prim_vf(eqn_idx%B%beg)%sf(j, k, l)
1683 b(2) = q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l)
1684 b(3) = q_prim_vf(eqn_idx%B%beg + 2)%sf(j, k, l)
1685 end if
1686
1687 v2 = 0._wp
1688 do i = eqn_idx%mom%beg, eqn_idx%mom%end
1689 v2 = v2 + q_prim_vf(i)%sf(j, k, l)**2
1690 end do
1691 if (v2 >= 1._wp) call s_mpi_abort('Error: v squared > 1 in s_convert_primitive_to_conservative_variables')
1692
1693 ga = 1._wp/sqrt(1._wp - v2)
1694
1695 h = 1._wp + (gamma + 1)*q_prim_vf(eqn_idx%E)%sf(j, k, l)/rho ! Assume perfect gas for now
1696
1697 b2 = 0._wp
1698 do i = eqn_idx%B%beg, eqn_idx%B%end
1699 b2 = b2 + q_prim_vf(i)%sf(j, k, l)**2
1700 end do
1701 if (n == 0) b2 = b2 + bx0**2
1702
1703 vdotb = 0._wp
1704 do i = 1, 3
1705 vdotb = vdotb + q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)*b(i)
1706 end do
1707
1708 do i = 1, eqn_idx%cont%end
1709 q_cons_vf(i)%sf(j, k, l) = ga*q_prim_vf(i)%sf(j, k, l)
1710 end do
1711
1712 do i = eqn_idx%mom%beg, eqn_idx%mom%end
1713 q_cons_vf(i)%sf(j, k, l) = (rho*h*ga**2 + b2)*q_prim_vf(i)%sf(j, k, &
1714 & l) - vdotb*b(i - eqn_idx%mom%beg + 1)
1715 end do
1716
1717 q_cons_vf(eqn_idx%E)%sf(j, k, l) = rho*h*ga**2 - q_prim_vf(eqn_idx%E)%sf(j, k, &
1718 & l) + 0.5_wp*(b2 + v2*b2 - vdotb**2)
1719 ! Remove rest energy
1720 do i = 1, eqn_idx%cont%end
1721 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)
1722 end do
1723
1724 do i = eqn_idx%B%beg, eqn_idx%B%end
1725 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
1726 end do
1727
1728 cycle ! skip all the non-relativistic conversions below
1729 end if
1730
1731 ! Transferring the continuity equation(s) variable(s)
1732 do i = 1, eqn_idx%cont%end
1733 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
1734 end do
1735
1736 ! Zeroing out the dynamic pressure since it is computed iteratively by cycling through the velocity equations
1737 dyn_pres = 0._wp
1738
1739 ! Computing momenta and dynamic pressure from velocity
1740 do i = eqn_idx%mom%beg, eqn_idx%mom%end
1741 q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l)
1742 dyn_pres = dyn_pres + q_cons_vf(i)%sf(j, k, l)*q_prim_vf(i)%sf(j, k, l)/2._wp
1743 end do
1744
1745 if (chemistry) then
1746 ! Reacting mixture: compute conserved energy from species mass fractions and temperature
1747 do i = eqn_idx%species%beg, eqn_idx%species%end
1748 ys(i - eqn_idx%species%beg + 1) = q_prim_vf(i)%sf(j, k, l)
1749 q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l)
1750 end do
1751
1752 call get_mixture_molecular_weight(ys, mix_mol_weight)
1753 t = q_prim_vf(eqn_idx%E)%sf(j, k, l)*mix_mol_weight/(gas_constant*rho)
1754 call get_mixture_energy_mass(t, ys, e_mix)
1755
1756 q_cons_vf(eqn_idx%E)%sf(j, k, l) = dyn_pres + rho*e_mix
1757 else
1758 ! Computing the energy from the pressure
1759 if (mhd) then
1760 if (n == 0) then
1761 pres_mag = 0.5_wp*(bx0**2 + q_prim_vf(eqn_idx%B%beg)%sf(j, k, &
1762 & l)**2 + q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l)**2)
1763 else
1764 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, &
1765 & k, l)**2 + q_prim_vf(eqn_idx%B%beg + 2)%sf(j, k, l)**2)
1766 end if
1767 ! MHD energy includes magnetic pressure contribution
1768 q_cons_vf(eqn_idx%E)%sf(j, k, l) = gamma*q_prim_vf(eqn_idx%E)%sf(j, k, &
1769 & l) + dyn_pres + pres_mag + pi_inf + qv
1770 else if (bubbles_euler .neqv. .true.) then
1771 ! Five-equation model (Allaire et al. JCP 2002): E = Gamma*p + 0.5*rho*|u|^2 + pi_inf + qv
1772 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
1773 else
1774 ! Bubble-augmented energy; qv is an energy density and is not diluted
1775 q_cons_vf(eqn_idx%E)%sf(j, k, l) = dyn_pres + (1._wp - q_prim_vf(eqn_idx%alf)%sf(j, k, &
1776 & l))*(gamma*q_prim_vf(eqn_idx%E)%sf(j, k, l) + pi_inf) + qv
1777 end if
1778 end if
1779
1780 ! Six-equation model (Saurel et al. JCP 2009): compute per-phase internal energies
1781 if (model_eqns == model_eqns_6eq) then
1782 do i = 1, num_fluids
1783 pres_i = q_prim_vf(eqn_idx%E)%sf(j, k, l)
1784 alpha_i = q_cons_vf(i + eqn_idx%adv%beg - 1)%sf(j, k, l)
1785 alpha_rho_i = q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)
1786 call s_phase_internal_energy(pres_i, alpha_i, alpha_rho_i, i, e_i)
1787 q_cons_vf(i + eqn_idx%int_en%beg - 1)%sf(j, k, l) = e_i
1788 end do
1789 end if
1790
1791 if (bubbles_euler) then
1792 ! From prim: Compute nbub = (3/4pi) * \alpha / \bar{R^3}
1793 do i = 1, nb
1794 rtmp(i) = q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l)
1795 end do
1796
1797 if (.not. qbmm) then
1798 if (adv_n) then
1799 q_cons_vf(eqn_idx%n)%sf(j, k, l) = q_prim_vf(eqn_idx%n)%sf(j, k, l)
1800 nbub = q_prim_vf(eqn_idx%n)%sf(j, k, l)
1801 else
1802 call s_comp_n_from_prim(real(q_prim_vf(eqn_idx%alf)%sf(j, k, l), kind=wp), rtmp, nbub, weight)
1803 end if
1804 else
1805 ! Initialize R3 averaging over R0 and R directions
1806 r3tmp = 0._wp
1807 do i = 1, nb
1808 r3tmp = r3tmp + weight(i)*0.5_wp*(rtmp(i) + sigr)**3._wp
1809 r3tmp = r3tmp + weight(i)*0.5_wp*(rtmp(i) - sigr)**3._wp
1810 end do
1811 ! Initialize nb
1812 nbub = 3._wp*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4._wp*pi*r3tmp)
1813 end if
1814
1815 do i = eqn_idx%bub%beg, eqn_idx%bub%end
1816 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)*nbub
1817 end do
1818 end if
1819
1820 if (mhd) then
1821 do i = eqn_idx%B%beg, eqn_idx%B%end
1822 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
1823 end do
1824 end if
1825
1826 if (hypoelasticity) then
1827 ! adding the elastic contribution Multiply \tau to \rho \tau
1828 do i = eqn_idx%stress%beg, eqn_idx%stress%end
1829 q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l)
1830 end do
1831 end if
1832
1833 if (hypoelasticity) then
1834 ! Elastic energy uses the undamaged modulus
1835 do i = eqn_idx%stress%beg, eqn_idx%stress%end
1836 ! Elastic energy addition (guard skips when G near zero from alpha undershoot)
1837 if (g > verysmall) then
1838 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, &
1839 & l)**2._wp)/max(4._wp*g, verysmall)
1840 ! Double for shear stresses
1841 if (any(i == shear_indices)) then
1842 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, &
1843 & l)**2._wp)/max(4._wp*g, verysmall)
1844 end if
1845 end if
1846 end do
1847 end if
1848
1849 if (surface_tension) then
1850 q_cons_vf(eqn_idx%c)%sf(j, k, l) = q_prim_vf(eqn_idx%c)%sf(j, k, l)
1851 end if
1852
1853 if (cont_damage) then
1854 ! U_D = m_s*D (damageable-solid partial mass)
1855 solid_partial_density = 0._wp
1856 do i = 1, num_fluids
1857 if (fluid_pp(i)%G > verysmall) then
1858 solid_partial_density = solid_partial_density + q_prim_vf(eqn_idx%cont%beg + i - 1)%sf(j, k, l)
1859 end if
1860 end do
1861 q_cons_vf(eqn_idx%damage)%sf(j, k, l) = solid_partial_density*q_prim_vf(eqn_idx%damage)%sf(j, k, l)
1862 end if
1863
1864 if (hyper_cleaning) q_cons_vf(eqn_idx%psi)%sf(j, k, l) = q_prim_vf(eqn_idx%psi)%sf(j, k, l)
1865 end do
1866 end do
1867 end do
1868
1869 end subroutine s_convert_primitive_to_conservative_variables
1870
1871 !> Convert primitive variables to Eulerian flux variables.
1872 subroutine s_convert_primitive_to_flux_variables(qK_prim_vf, FK_vf, FK_src_vf, is1, is2, is3, s2b, s3b, dir_idx_in, &
1873 & dir_flg_in, hll_u_interface_in)
1874
1875 integer, intent(in) :: s2b, s3b
1876 !> Working-direction mapping, passed explicitly: it is simulation state (m_global_parameters), and use-associating it into
1877 !! this common kernel spills registers on AMD OpenMP offload.
1878 integer, dimension(3), intent(in) :: dir_idx_in
1879 real(wp), dimension(3), intent(in) :: dir_flg_in
1880 logical, intent(in) :: hll_u_interface_in
1881 real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(in) :: qk_prim_vf
1882 real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: fk_vf
1883 real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,eqn_idx%adv%beg:), intent(inout) :: fk_src_vf
1884 type(int_bounds_info), intent(in) :: is1, is2, is3
1885
1886 ! Partial densities, density, velocity, pressure, energy, advection variables, the specific heat ratio and liquid stiffness
1887 ! functions, the shear and volume Reynolds numbers and the Weber numbers
1888
1889# 961 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1890 real(wp), dimension(num_fluids) :: alpha_rho_k
1891 real(wp), dimension(num_fluids) :: alpha_k
1892 real(wp), dimension(num_vels) :: vel_k
1893# 965 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1894 real(wp), dimension(1) :: y_k
1895# 966 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1896 real(wp) :: rho_k
1897 real(wp) :: vel_k_sum
1898 real(wp) :: pres_k
1899 real(wp) :: e_k
1900 real(wp) :: gamma_k
1901 real(wp) :: pi_inf_k
1902 real(wp) :: qv_k
1903 real(wp), dimension(2) :: re_k
1904 real(wp) :: g_k
1905 real(wp) :: blkmod1_k, blkmod2_k, k_k
1906 real(wp) :: t_k, mix_mol_weight, r_gas
1907 integer :: i, j, k, l !< Generic loop iterators
1908
1909 is1b = is1%beg; is1e = is1%end
1910 is2b = is2%beg; is2e = is2%end
1911 is3b = is3%beg; is3e = is3%end
1912
1913
1914# 983 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1915#if defined(MFC_OpenACC)
1916# 983 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1917!$acc update device(is1b, is2b, is3b, is1e, is2e, is3e)
1918# 983 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1919#elif defined(MFC_OpenMP)
1920# 983 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1921!$omp target update to(is1b, is2b, is3b, is1e, is2e, is3e)
1922# 983 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1923#endif
1924# 984 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1925
1926 ! Computing the flux variables from the primitive variables, without accounting for the contribution of either viscosity or
1927 ! capillarity
1928
1929# 987 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1930
1931# 987 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1932#if defined(MFC_OpenACC)
1933# 987 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1934!$acc parallel loop collapse(3) gang vector default(present) &
1935# 987 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1936!$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) &
1937# 987 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1938!$acc& copyin(dir_idx_in, dir_flg_in, hll_u_interface_in)
1939# 987 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1940#elif defined(MFC_OpenMP)
1941# 987 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1942
1943# 987 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1944
1945# 987 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1946
1947# 987 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1948!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1949# 987 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1950!$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) &
1951# 987 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1952!$omp& map(to:dir_idx_in, dir_flg_in, hll_u_interface_in)
1953# 987 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1954#endif
1955# 990 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1956 do l = is3b, is3e
1957 do k = is2b, is2e
1958 do j = is1b, is1e
1959
1960# 993 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1961#if defined(MFC_OpenACC)
1962# 993 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1963!$acc loop seq
1964# 993 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1965#elif defined(MFC_OpenMP)
1966# 993 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1967
1968# 993 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1969#endif
1970# 994 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1971 do i = 1, eqn_idx%cont%end
1972 alpha_rho_k(i) = qk_prim_vf(j, k, l, i)
1973 end do
1974
1975
1976# 998 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1977#if defined(MFC_OpenACC)
1978# 998 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1979!$acc loop seq
1980# 998 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1981#elif defined(MFC_OpenMP)
1982# 998 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1983
1984# 998 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1985#endif
1986# 999 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1987 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1988 alpha_k(i - eqn_idx%E) = qk_prim_vf(j, k, l, i)
1989 end do
1990
1991
1992# 1003 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1993#if defined(MFC_OpenACC)
1994# 1003 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1995!$acc loop seq
1996# 1003 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1997#elif defined(MFC_OpenMP)
1998# 1003 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1999
2000# 1003 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2001#endif
2002# 1004 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2003 do i = 1, num_vels
2004 vel_k(i) = qk_prim_vf(j, k, l, eqn_idx%cont%end + i)
2005 end do
2006
2007 vel_k_sum = 0._wp
2008
2009# 1009 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2010#if defined(MFC_OpenACC)
2011# 1009 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2012!$acc loop seq
2013# 1009 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2014#elif defined(MFC_OpenMP)
2015# 1009 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2016
2017# 1009 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2018#endif
2019# 1010 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2020 do i = 1, num_vels
2021 vel_k_sum = vel_k_sum + vel_k(i)**2._wp
2022 end do
2023
2024 pres_k = qk_prim_vf(j, k, l, eqn_idx%E)
2025 if (hypoelasticity) then
2026 call s_convert_species_to_mixture_variables_kernel(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, alpha_rho_k, &
2027 & re_k, g_k, gs_vc)
2028 else
2029 call s_convert_species_to_mixture_variables_kernel(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, alpha_rho_k, &
2030 & re_k)
2031 end if
2032
2033 ! Computing the energy from the pressure
2034
2035 if (chemistry) then
2036
2037# 1026 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2038#if defined(MFC_OpenACC)
2039# 1026 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2040!$acc loop seq
2041# 1026 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2042#elif defined(MFC_OpenMP)
2043# 1026 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2044
2045# 1026 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2046#endif
2047# 1027 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2048 do i = eqn_idx%species%beg, eqn_idx%species%end
2049 y_k(i - eqn_idx%species%beg + 1) = qk_prim_vf(j, k, l, i)
2050 end do
2051 ! Computing the energy from the internal energy of the mixture
2052 call get_mixture_molecular_weight(y_k, mix_mol_weight)
2053 r_gas = gas_constant/mix_mol_weight
2054 t_k = pres_k/rho_k/r_gas
2055 call get_mixture_energy_mass(t_k, y_k, e_k)
2056 e_k = rho_k*e_k + 5.e-1_wp*rho_k*vel_k_sum
2057 else
2058 ! Computing the energy from the pressure
2059 e_k = gamma_k*pres_k + pi_inf_k + 5.e-1_wp*rho_k*vel_k_sum + qv_k
2060 end if
2061
2062 ! mass flux, this should be \alpha_i \rho_i u_i
2063
2064# 1042 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2065#if defined(MFC_OpenACC)
2066# 1042 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2067!$acc loop seq
2068# 1042 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2069#elif defined(MFC_OpenMP)
2070# 1042 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2071
2072# 1042 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2073#endif
2074# 1043 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2075 do i = 1, eqn_idx%cont%end
2076 fk_vf(j, k, l, i) = alpha_rho_k(i)*vel_k(dir_idx_in(1))
2077 end do
2078
2079
2080# 1047 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2081#if defined(MFC_OpenACC)
2082# 1047 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2083!$acc loop seq
2084# 1047 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2085#elif defined(MFC_OpenMP)
2086# 1047 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2087
2088# 1047 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2089#endif
2090# 1048 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2091 do i = 1, num_vels
2092 fk_vf(j, k, l, &
2093 & eqn_idx%cont%end + dir_idx_in(i)) = rho_k*vel_k(dir_idx_in(1))*vel_k(dir_idx_in(i)) &
2094 & + pres_k*dir_flg_in(dir_idx_in(i))
2095 end do
2096
2097 ! energy flux, u(E+p)
2098 fk_vf(j, k, l, eqn_idx%E) = vel_k(dir_idx_in(1))*(e_k + pres_k)
2099
2100 ! Species advection Flux, \rho*u*Y
2101 if (chemistry) then
2102
2103# 1059 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2104#if defined(MFC_OpenACC)
2105# 1059 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2106!$acc loop seq
2107# 1059 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2108#elif defined(MFC_OpenMP)
2109# 1059 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2110
2111# 1059 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2112#endif
2113# 1060 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2114 do i = 1, num_species
2115 fk_vf(j, k, l, i - 1 + eqn_idx%species%beg) = vel_k(dir_idx_in(1))*(rho_k*y_k(i))
2116 end do
2117 end if
2118
2119 ! Match the volume-fraction flux representation exported by the Riemann solver. HLL Method 1: zero alpha
2120 ! flux plus per-fluid interface-alpha source traces. Hypoelastic HLLD folds every non-conservative term
2121 ! into its augmented flux (adv_src_mode_none), so its source trace is zero; for this cell-local conversion
2122 ! the fold collapses exactly to -/+ K*u_n on the two volume-fraction rows (K = 0 without alt_soundspeed),
2123 ! with the same two-fluid longitudinal-modulus K as the HLLD kernel (num_fluids = 2 is checker-enforced).
2124 ! MHD HLLD keeps the per-fluid-trace representation it has always used. HLL Method 2, HLLC, and LF use the
2125 ! shared-velocity representation below.
2126 if (riemann_solver == riemann_solver_hlld) then
2127 if (hypoelasticity) then
2128 k_k = 0._wp
2129 ! The fluid-2 subscripts must not be compiled when case optimization
2130 ! bakes num_fluids = 1 (amdflang rejects them at compile time); the
2131 ! checker prohibits hypoelastic HLLD there, so the block is dead code.
2132# 1079 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2133 if (alt_soundspeed) then
2134 blkmod1_k = f_bulk_modulus(pres_k, gammas(1), pi_infs(1)) + (4._wp/3._wp)*gs_vc(1)
2135 blkmod2_k = f_bulk_modulus(pres_k, gammas(2), pi_infs(2)) + (4._wp/3._wp)*gs_vc(2)
2136 k_k = alpha_k(1)*alpha_k(2)*(blkmod2_k - blkmod1_k)/(alpha_k(1)*blkmod2_k + alpha_k(2) &
2137 & *blkmod1_k + verysmall)
2138 end if
2139# 1086 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2140
2141# 1086 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2142#if defined(MFC_OpenACC)
2143# 1086 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2144!$acc loop seq
2145# 1086 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2146#elif defined(MFC_OpenMP)
2147# 1086 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2148
2149# 1086 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2150#endif
2151# 1087 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2152 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2153 fk_vf(j, k, l, i) = 0._wp
2154 fk_src_vf(j, k, l, i) = 0._wp
2155 end do
2156 fk_vf(j, k, l, eqn_idx%adv%beg) = -k_k*vel_k(dir_idx_in(1))
2157 fk_vf(j, k, l, eqn_idx%adv%end) = k_k*vel_k(dir_idx_in(1))
2158 else
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 end if
2176 else if (riemann_solver == riemann_solver_hll .and. .not. hll_u_interface_in) then
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) = 0._wp
2191 fk_src_vf(j, k, l, i) = alpha_k(i - eqn_idx%E)
2192 end do
2193 else
2194 ! Could be bubbles_euler!
2195
2196# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2197#if defined(MFC_OpenACC)
2198# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2199!$acc loop seq
2200# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2201#elif defined(MFC_OpenMP)
2202# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2203
2204# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2205#endif
2206# 1109 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2207 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2208 fk_vf(j, k, l, i) = vel_k(dir_idx_in(1))*alpha_k(i - eqn_idx%E)
2209 end do
2210
2211
2212# 1113 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2213#if defined(MFC_OpenACC)
2214# 1113 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2215!$acc loop seq
2216# 1113 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2217#elif defined(MFC_OpenMP)
2218# 1113 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2219
2220# 1113 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2221#endif
2222# 1114 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2223 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2224 fk_src_vf(j, k, l, i) = vel_k(dir_idx_in(1))
2225 end do
2226 end if
2227 end do
2228 end do
2229 end do
2230
2231# 1121 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2232#if defined(MFC_OpenACC)
2233# 1121 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2234!$acc end parallel loop
2235# 1121 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2236#elif defined(MFC_OpenMP)
2237# 1121 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2238
2239# 1121 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2240!$omp end target teams loop
2241# 1121 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2242#endif
2243# 1122 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2244
2245 end subroutine s_convert_primitive_to_flux_variables
2246
2247 !> Compute partial densities and volume fractions
2248 subroutine s_compute_species_fraction(q_vf, k, l, r, alpha_rho_K, alpha_K)
2249
2250
2251# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2252#ifdef _CRAYFTN
2253# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2254#if MFC_OpenACC
2255# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2256!$acc routine seq
2257# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2258#elif MFC_OpenMP
2259# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2260
2261# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2262
2263# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2264!$omp declare target device_type(any)
2265# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2266#else
2267# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2268!DIR$ NOINLINE s_compute_species_fraction
2269# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2270#endif
2271# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2272#elif MFC_OpenACC
2273# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2274!$acc routine seq
2275# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2276#elif MFC_OpenMP
2277# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2278
2279# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2280
2281# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2282!$omp declare target device_type(any)
2283# 1128 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2284#endif
2285# 1129 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2286 type(scalar_field), dimension(sys_size), intent(in) :: q_vf
2287 integer, intent(in) :: k, l, r
2288# 1134 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2289 real(wp), dimension(num_fluids), intent(out) :: alpha_rho_k, alpha_k
2290# 1136 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2291 integer :: i
2292 real(wp) :: alpha_k_sum
2293
2294 if (num_fluids == 1) then
2295 alpha_rho_k(1) = q_vf(eqn_idx%cont%beg)%sf(k, l, r)
2296 if (igr .or. bubbles_euler) then
2297 alpha_k(1) = 1._wp
2298 else
2299 alpha_k(1) = q_vf(eqn_idx%adv%beg)%sf(k, l, r)
2300 end if
2301 else
2302 if (igr) then
2303 do i = 1, num_fluids - 1
2304 alpha_rho_k(i) = q_vf(i)%sf(k, l, r)
2305 alpha_k(i) = q_vf(eqn_idx%adv%beg + i - 1)%sf(k, l, r)
2306 end do
2307 alpha_rho_k(num_fluids) = q_vf(num_fluids)%sf(k, l, r)
2308 alpha_k(num_fluids) = 1._wp - sum(alpha_k(1:num_fluids - 1))
2309 else
2310 do i = 1, num_fluids
2311 alpha_rho_k(i) = q_vf(i)%sf(k, l, r)
2312 alpha_k(i) = q_vf(eqn_idx%adv%beg + i - 1)%sf(k, l, r)
2313 end do
2314 end if
2315 end if
2316
2317 if (mpp_lim) then
2318 alpha_k_sum = 0._wp
2319 do i = 1, num_fluids
2320 alpha_rho_k(i) = max(0._wp, alpha_rho_k(i))
2321 alpha_k(i) = min(max(0._wp, alpha_k(i)), 1._wp)
2322 alpha_k_sum = alpha_k_sum + alpha_k(i)
2323 end do
2324 alpha_k = alpha_k/max(alpha_k_sum, 1.e-16_wp)
2325 end if
2326
2327 if (num_fluids == 1 .and. bubbles_euler) alpha_k(1) = q_vf(eqn_idx%adv%beg)%sf(k, l, r)
2328
2329 end subroutine s_compute_species_fraction
2330
2331 !> Deallocate fluid property arrays and post-processing fields allocated during module initialization.
2332 impure subroutine s_finalize_variables_conversion_module()
2333
2334 if (allocated(rho_sf)) deallocate (rho_sf, gamma_sf, pi_inf_sf)
2335
2336#ifdef MFC_DEBUG
2337# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2338 block
2339# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2340 use iso_fortran_env, only: output_unit
2341# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2342
2343# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2344 print *, 'm_variables_conversion.fpp:1181: ', '@:DEALLOCATE(Gs_vc, fluid_k_therm)'
2345# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2346
2347# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2348 call flush (output_unit)
2349# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2350 end block
2351# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2352#endif
2353# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2354
2355# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2356#if defined(MFC_OpenACC)
2357# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2358!$acc exit data delete(Gs_vc, fluid_k_therm)
2359# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2360#elif defined(MFC_OpenMP)
2361# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2362!$omp target exit data map(release:Gs_vc, fluid_k_therm)
2363# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2364#endif
2365# 1181 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2366 deallocate (gs_vc, fluid_k_therm)
2367# 1182 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2368 if (allocated(bubrs_vc)) then
2369#ifdef MFC_DEBUG
2370# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2371 block
2372# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2373 use iso_fortran_env, only: output_unit
2374# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2375
2376# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2377 print *, 'm_variables_conversion.fpp:1183: ', '@:DEALLOCATE(bubrs_vc)'
2378# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2379
2380# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2381 call flush (output_unit)
2382# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2383 end block
2384# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2385#endif
2386# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2387
2388# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2389#if defined(MFC_OpenACC)
2390# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2391!$acc exit data delete(bubrs_vc)
2392# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2393#elif defined(MFC_OpenMP)
2394# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2395!$omp target exit data map(release:bubrs_vc)
2396# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2397#endif
2398# 1183 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2399 deallocate (bubrs_vc)
2400# 1184 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2401 end if
2402 if (allocated(res_vc)) then
2403#ifdef MFC_DEBUG
2404# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2405 block
2406# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2407 use iso_fortran_env, only: output_unit
2408# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2409
2410# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2411 print *, 'm_variables_conversion.fpp:1186: ', '@:DEALLOCATE(Res_vc)'
2412# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2413
2414# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2415 call flush (output_unit)
2416# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2417 end block
2418# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2419#endif
2420# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2421
2422# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2423#if defined(MFC_OpenACC)
2424# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2425!$acc exit data delete(Res_vc)
2426# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2427#elif defined(MFC_OpenMP)
2428# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2429!$omp target exit data map(release:Res_vc)
2430# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2431#endif
2432# 1186 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2433 deallocate (res_vc)
2434# 1187 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2435 end if
2436
2437 end subroutine s_finalize_variables_conversion_module
2438
2439 !> Total energy per unit volume, thermodynamic terms only. Callers add magnetic and elastic energy, which are not
2440 !! equation-of-state terms. The chemistry and relativistic branches use a different relation and stay open-coded.
2441 subroutine s_compute_energy(pres, alpha_rho_K, alpha_K, vel_sum, E)
2442
2443
2444# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2445#ifdef _CRAYFTN
2446# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2447#if MFC_OpenACC
2448# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2449!$acc routine seq
2450# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2451#elif MFC_OpenMP
2452# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2453
2454# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2455
2456# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2457!$omp declare target device_type(any)
2458# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2459#else
2460# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2461!DIR$ INLINEALWAYS s_compute_energy
2462# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2463#endif
2464# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2465#elif MFC_OpenACC
2466# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2467!$acc routine seq
2468# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2469#elif MFC_OpenMP
2470# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2471
2472# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2473
2474# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2475!$omp declare target device_type(any)
2476# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2477#endif
2478# 1196 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2479
2480# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2481 real(wp), dimension(num_fluids), intent(in) :: alpha_rho_k, alpha_k
2482# 1202 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2483 real(wp), intent(in) :: pres, vel_sum
2484 real(wp), intent(out) :: e
2485 real(wp) :: rho, gamma, pi_inf, qv
2486
2487 call s_compute_mixture_coefficients(alpha_rho_k, alpha_k, rho, gamma, pi_inf, qv)
2488
2489 ! E = dyn_p + (1 - alf)(gamma p + pi_inf) + qv. Only the liquid's internal energy is diluted;
2490 ! qv is already an energy density.
2491 e = gamma*pres + pi_inf
2492 if (bubbles_euler) e = e*(1._wp - alpha_k(num_fluids))
2493 e = e + qv + 5.e-1_wp*rho*vel_sum
2494
2495 end subroutine s_compute_energy
2496
2497 !> Elastic strain energy of one stress component, doubled for a shear component: the tensor stores it once, the energy counts
2498 !! both off-diagonal entries. Zero without a shear modulus.
2499 function f_elastic_energy(tau, G, is_shear) result(dE)
2500
2501
2502# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2503#ifdef _CRAYFTN
2504# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2505#if MFC_OpenACC
2506# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2507!$acc routine seq
2508# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2509#elif MFC_OpenMP
2510# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2511
2512# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2513
2514# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2515!$omp declare target device_type(any)
2516# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2517#else
2518# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2519!DIR$ INLINEALWAYS f_elastic_energy
2520# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2521#endif
2522# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2523#elif MFC_OpenACC
2524# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2525!$acc routine seq
2526# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2527#elif MFC_OpenMP
2528# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2529
2530# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2531
2532# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2533!$omp declare target device_type(any)
2534# 1220 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2535#endif
2536# 1221 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2537
2538 real(wp), intent(in) :: tau, g
2539 logical, intent(in) :: is_shear
2540 real(wp) :: de
2541
2542 de = 0._wp
2543 if (g > verysmall) then
2544 de = (tau*tau)/max(4._wp*g, verysmall)
2545 if (is_shear) de = de + (tau*tau)/max(4._wp*g, verysmall)
2546 end if
2547
2548 end function f_elastic_energy
2549
2550 !> Hypoelastic strain energy at one cell, summed over the stress components.
2551 function f_hypoelastic_energy(q_cons_vf, j, k, l, rho, G) result(E_e)
2552
2553 type(scalar_field), dimension(sys_size), intent(in) :: q_cons_vf
2554 integer, intent(in) :: j, k, l
2555 real(wp), intent(in) :: rho, g
2556 real(wp) :: e_e
2557 integer :: s
2558
2559 e_e = 0._wp
2560 do s = eqn_idx%stress%beg, eqn_idx%stress%end
2561 e_e = e_e + f_elastic_energy(real(q_cons_vf(s)%sf(j, k, l), wp)/rho, g, any(s == shear_indices))
2562 end do
2563
2564 end function f_hypoelastic_energy
2565
2566 !> Compute the fast magnetosonic wave speed from the sound speed, density, and magnetic field components.
2567 subroutine s_compute_fast_magnetosonic_speed(rho, c, B, norm, c_fast, h)
2568
2569
2570# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2571#ifdef _CRAYFTN
2572# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2573#if MFC_OpenACC
2574# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2575!$acc routine seq
2576# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2577#elif MFC_OpenMP
2578# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2579
2580# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2581
2582# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2583!$omp declare target device_type(any)
2584# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2585#else
2586# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2587!DIR$ NOINLINE s_compute_fast_magnetosonic_speed
2588# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2589#endif
2590# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2591#elif MFC_OpenACC
2592# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2593!$acc routine seq
2594# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2595#elif MFC_OpenMP
2596# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2597
2598# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2599
2600# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2601!$omp declare target device_type(any)
2602# 1253 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2603#endif
2604# 1254 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2605
2606 real(wp), intent(in) :: b(3), rho, c
2607 real(wp), intent(in) :: h !< only used for relativity
2608 real(wp), intent(out) :: c_fast
2609 integer, intent(in) :: norm
2610 real(wp) :: b2, term, disc
2611
2612 b2 = sum(b**2)
2613
2614 if (.not. relativity) then
2615 term = c**2 + b2/rho
2616 disc = term**2 - 4*c**2*(b(norm)**2/rho)
2617 else
2618 ! Note: this is approximation for the non-relatisitic limit; accurate solution requires solving a quartic equation
2619 term = (c**2*(b(norm)**2 + rho*h) + b2)/(rho*h + b2)
2620 disc = term**2 - 4*c**2*b(norm)**2/(rho*h + b2)
2621 end if
2622
2623#ifdef MFC_DEBUG
2624 if (disc < 0._wp) then
2625 print *, 'rho, c, Bx, By, Bz, h, term, disc:', rho, c, b(1), b(2), b(3), h, term, disc
2626 ! s_mpi_abort is a host routine and cannot be called from device code
2627 ! (this is a GPU routine); on GPU builds, emit the diagnostic print only.
2628#ifndef MFC_GPU
2629 call s_mpi_abort('Error: negative discriminant in s_compute_fast_magnetosonic_speed')
2630#endif
2631 end if
2632#endif
2633
2634 c_fast = sqrt(0.5_wp*(term + sqrt(disc)))
2635
2636 end subroutine s_compute_fast_magnetosonic_speed
2637
2638end module m_variables_conversion
q_cons_vf
type(scalar_field), dimension(sys_size), intent(inout) q_cons_vf
Definition m_phase_change.fpp.f90:1047
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1049
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1049
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1049
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:2332
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:2117
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:2028
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:1883
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:2201
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:472
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:457
m_global_parameters_common::igr
logical igr
Definition m_global_parameters_common.fpp.f90:415
m_global_parameters_common::bubbles_lagrange
logical bubbles_lagrange
Definition m_global_parameters_common.fpp.f90:397
m_global_parameters_common::bubbles_euler
logical bubbles_euler
Definition m_global_parameters_common.fpp.f90:396
m_global_parameters_common::cont_damage
logical cont_damage
Definition m_global_parameters_common.fpp.f90:401
m_global_parameters_common::relativity
logical relativity
Definition m_global_parameters_common.fpp.f90:460
m_global_parameters_common::hyper_cleaning
logical hyper_cleaning
Definition m_global_parameters_common.fpp.f90:412
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:484
m_global_parameters_common::hypoelasticity
logical hypoelasticity
Definition m_global_parameters_common.fpp.f90:413
m_global_parameters_common::model_eqns
integer model_eqns
Definition m_global_parameters_common.fpp.f90:428
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:565
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:512
m_global_parameters_common::chemistry
logical, parameter chemistry
Definition m_global_parameters_common.fpp.f90:517
m_global_parameters_common::num_fluids
integer num_fluids
Definition m_global_parameters_common.fpp.f90:436
m_global_parameters_common::nb
integer nb
Definition m_global_parameters_common.fpp.f90:434
m_global_parameters_common::adv_n
logical adv_n
Definition m_global_parameters_common.fpp.f90:393
m_global_parameters_common::mhd
logical mhd
Definition m_global_parameters_common.fpp.f90:421
m_global_parameters_common::n
integer n
Definition m_global_parameters_common.fpp.f90:431
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:524
m_global_parameters
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
Definition m_global_parameters.fpp.f90:19
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90: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
Broadcasts user inputs and decomposes the domain across MPI ranks for pre-processing.
Definition m_mpi_proxy.fpp.f90:7
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90: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:2500
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:2249
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:2333
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:2552
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:1630
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:2442
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:1874
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:2568
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