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