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