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# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
87
88# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
89
90# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
91
92# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
93
94# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
95
96# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
97
98# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
99
100# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
101
102# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
103
104# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
105
106# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
107
108# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
109
110# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
111
112# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
113
114# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
115
116# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
117# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126
127# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
128
129# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
130
131# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
132
133# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
134
135# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
136
137# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
138
139# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
140
141# 377 "/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 type(scalar_field), dimension(sys_size), intent(in) :: qk_cons_vf
1238 type(scalar_field), intent(inout) :: q_t_sf
1239 type(scalar_field), dimension(sys_size), intent(inout) :: qk_prim_vf
1240 type(int_bounds_info), dimension(1:3), intent(in) :: ibounds
1241
1242# 437 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1243 real(wp), dimension(num_fluids) :: alpha_k, alpha_rho_k
1244 real(wp), dimension(nb) :: nrtmp
1245 real(wp) :: rhoyks(1:num_species)
1246# 441 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1247 real(wp), dimension(2) :: re_k
1248 real(wp) :: rho_k, gamma_k, pi_inf_k, qv_k, dyn_pres_k
1249 real(wp) :: vftmp, nbub_sc
1250 real(wp) :: g_k
1251 real(wp) :: pres
1252 integer :: i, j, k, l !< Generic loop iterators
1253 real(wp) :: t
1254 real(wp) :: pres_mag
1255 real(wp) :: ga !< Lorentz factor (gamma in relativity)
1256 real(wp) :: b2 !< Magnetic field magnitude squared
1257 real(wp) :: b(3) !< Magnetic field components
1258 real(wp) :: m2 !< Relativistic momentum magnitude squared
1259 real(wp) :: s !< Dot product of the magnetic field and the relativistic momentum
1260 real(wp) :: w, dw !< W := rho*v*Ga**2; f = f(W) in Newton-Raphson
1261 real(wp) :: e, d !< Prim/Cons variables within Newton-Raphson iteration
1262 real(wp) :: f, dga_dw, dp_dw, df_dw !< Functions within Newton-Raphson iteration
1263 integer :: iter !< Newton-Raphson iteration counter
1264
1265
1266# 459 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1267
1268# 459 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1269#if defined(MFC_OpenACC)
1270# 459 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1271!$acc parallel loop collapse(3) gang vector default(present) &
1272# 459 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1273!$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)
1274# 459 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1275#elif defined(MFC_OpenMP)
1276# 459 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1277
1278# 459 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1279
1280# 459 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1281
1282# 459 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1283!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
1284# 459 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1285!$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)
1286# 459 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1287#endif
1288# 462 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1289 do l = ibounds(3)%beg, ibounds(3)%end
1290 do k = ibounds(2)%beg, ibounds(2)%end
1291 do j = ibounds(1)%beg, ibounds(1)%end
1292 dyn_pres_k = 0._wp
1293
1294 call s_compute_species_fraction(qk_cons_vf, j, k, l, alpha_rho_k, alpha_k)
1295
1296#ifdef MFC_GPU
1297 ! Device regions call the device-compiled scalar kernel directly.
1298 if (hypoelasticity) then
1299 call s_convert_species_to_mixture_variables_kernel(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, alpha_rho_k, &
1300 & re_k, g_k, gs_vc)
1301 else
1302 call s_convert_species_to_mixture_variables_kernel(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, alpha_rho_k, &
1303 & re_k)
1304 end if
1305#else
1306 ! Host execution uses the wrapper, which also stores requested diagnostics.
1307 if (hypoelasticity) then
1308 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, &
1309 & fluid_pp(:)%G)
1310 else
1311 call s_convert_to_mixture_variables(qk_cons_vf, j, k, l, rho_k, gamma_k, pi_inf_k, qv_k)
1312 end if
1313#endif
1314
1315 ! Relativistic MHD primitive variable recovery, Mignone & Bodo A&A (2006)
1316 if (relativity) then
1317 if (n == 0) then
1318 b(1) = bx0
1319 b(2) = qk_cons_vf(eqn_idx%B%beg)%sf(j, k, l)
1320 b(3) = qk_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, l)
1321 else
1322 b(1) = qk_cons_vf(eqn_idx%B%beg)%sf(j, k, l)
1323 b(2) = qk_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, l)
1324 b(3) = qk_cons_vf(eqn_idx%B%beg + 2)%sf(j, k, l)
1325 end if
1326 b2 = b(1)**2 + b(2)**2 + b(3)**2
1327
1328 m2 = 0._wp
1329
1330# 502 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1331#if defined(MFC_OpenACC)
1332# 502 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1333!$acc loop seq
1334# 502 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1335#elif defined(MFC_OpenMP)
1336# 502 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1337
1338# 502 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1339#endif
1340 do i = eqn_idx%mom%beg, eqn_idx%mom%end
1341 m2 = m2 + qk_cons_vf(i)%sf(j, k, l)**2
1342 end do
1343
1344 s = 0._wp
1345
1346# 508 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1347#if defined(MFC_OpenACC)
1348# 508 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1349!$acc loop seq
1350# 508 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1351#elif defined(MFC_OpenMP)
1352# 508 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1353
1354# 508 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1355#endif
1356 do i = 1, 3
1357 s = s + qk_cons_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)*b(i)
1358 end do
1359
1360 e = qk_cons_vf(eqn_idx%E)%sf(j, k, l)
1361
1362 d = 0._wp
1363
1364# 516 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1365#if defined(MFC_OpenACC)
1366# 516 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1367!$acc loop seq
1368# 516 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1369#elif defined(MFC_OpenMP)
1370# 516 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1371
1372# 516 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1373#endif
1374 do i = 1, eqn_idx%cont%end
1375 d = d + qk_cons_vf(i)%sf(j, k, l)
1376 end do
1377
1378 ! Newton-Raphson
1379 w = e + d
1380
1381# 523 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1382#if defined(MFC_OpenACC)
1383# 523 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1384!$acc loop seq
1385# 523 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1386#elif defined(MFC_OpenMP)
1387# 523 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1388
1389# 523 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1390#endif
1391 do iter = 1, relativity_cons_to_prim_max_iter
1392 ! Lorentz factor from total enthalpy and magnetic field
1393 ga = (w + b2)*w/sqrt((w + b2)**2*w**2 - (m2*w**2 + s**2*(2*w + b2)))
1394 ! Thermal pressure from EOS
1395 pres = (w - d*ga)/((gamma_k + 1)*ga**2)
1396 f = w - pres + (1 - 1/(2*ga**2))*b2 - s**2/(2*w**2) - e - d
1397
1398 ! The first equation below corrects a typo in (Mignone & Bodo, 2006) m2*W**2 -> 2*m2*W**2, which would
1399 ! cancel with the 2* in other terms This corrected version is not used as the second equation
1400 ! empirically converges faster. First equation is kept for further investigation. dGa_dW = -Ga**3 * (
1401 ! S**2*(3*W**2+3*W*B2+B2**2) + m2*W**2 ) / (W**3 * (W+B2)**3) ! first (corrected)
1402 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)
1403
1404 dp_dw = (ga*(1 + d*dga_dw) - 2*w*dga_dw)/((gamma_k + 1)*ga**3)
1405 df_dw = 1 - dp_dw + (b2/ga**3)*dga_dw + s**2/w**3
1406
1407 dw = -f/df_dw
1408 w = w + dw
1409 if (abs(dw) < 1.e-12_wp*w) exit ! Relative convergence criterion
1410 end do
1411
1412 ! Recalculate pressure using converged W
1413 ga = (w + b2)*w/sqrt((w + b2)**2*w**2 - (m2*w**2 + s**2*(2*w + b2)))
1414 qk_prim_vf(eqn_idx%E)%sf(j, k, l) = (w - d*ga)/((gamma_k + 1)*ga**2)
1415
1416 ! Recover the other primitive variables
1417
1418# 550 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1419#if defined(MFC_OpenACC)
1420# 550 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1421!$acc loop seq
1422# 550 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1423#elif defined(MFC_OpenMP)
1424# 550 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1425
1426# 550 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1427#endif
1428 do i = 1, 3
1429 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, &
1430 & l) + (s/w)*b(i))/(w + b2)
1431 end do
1432 qk_prim_vf(1)%sf(j, k, l) = d/ga ! Hard-coded for single-component for now
1433
1434
1435# 557 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1436#if defined(MFC_OpenACC)
1437# 557 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1438!$acc loop seq
1439# 557 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1440#elif defined(MFC_OpenMP)
1441# 557 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1442
1443# 557 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1444#endif
1445 do i = eqn_idx%B%beg, eqn_idx%B%end
1446 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)
1447 end do
1448
1449 cycle ! skip all the non-relativistic conversions below
1450 end if
1451
1452 if (chemistry) then
1453 ! Reacting flow: recover density from species partial densities, compute mass fractions Y_k = rhoY_k / rho
1454 rho_k = 0._wp
1455
1456# 568 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1457#if defined(MFC_OpenACC)
1458# 568 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1459!$acc loop seq
1460# 568 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1461#elif defined(MFC_OpenMP)
1462# 568 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1463
1464# 568 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1465#endif
1466 do i = eqn_idx%species%beg, eqn_idx%species%end
1467 rho_k = rho_k + max(0._wp, qk_cons_vf(i)%sf(j, k, l))
1468 end do
1469
1470
1471# 573 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1472#if defined(MFC_OpenACC)
1473# 573 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1474!$acc loop seq
1475# 573 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1476#elif defined(MFC_OpenMP)
1477# 573 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1478
1479# 573 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1480#endif
1481 do i = 1, eqn_idx%cont%end
1482 qk_prim_vf(i)%sf(j, k, l) = rho_k
1483 end do
1484
1485
1486# 578 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1487#if defined(MFC_OpenACC)
1488# 578 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1489!$acc loop seq
1490# 578 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1491#elif defined(MFC_OpenMP)
1492# 578 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1493
1494# 578 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1495#endif
1496 do i = eqn_idx%species%beg, eqn_idx%species%end
1497 qk_prim_vf(i)%sf(j, k, l) = max(0._wp, qk_cons_vf(i)%sf(j, k, l)/rho_k)
1498 end do
1499 else
1500 ! Non-reacting: partial densities are directly primitive (alpha_i * rho_i)
1501
1502# 584 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1503#if defined(MFC_OpenACC)
1504# 584 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1505!$acc loop seq
1506# 584 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1507#elif defined(MFC_OpenMP)
1508# 584 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1509
1510# 584 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1511#endif
1512 do i = 1, eqn_idx%cont%end
1513 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)
1514 end do
1515 end if
1516
1517 if (enforce_density_floor_vc) rho_k = max(rho_k, sgm_eps)
1518
1519 ! Recover velocity from momentum: u = rho*u / rho, and accumulate dynamic pressure 0.5*rho*|u|^2
1520
1521# 593 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1522#if defined(MFC_OpenACC)
1523# 593 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1524!$acc loop seq
1525# 593 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1526#elif defined(MFC_OpenMP)
1527# 593 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1528
1529# 593 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1530#endif
1531 do i = eqn_idx%mom%beg, eqn_idx%mom%end
1532 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)/rho_k
1533 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)
1534 end do
1535
1536 if (chemistry) then
1537
1538# 600 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1539#if defined(MFC_OpenACC)
1540# 600 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1541!$acc loop seq
1542# 600 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1543#elif defined(MFC_OpenMP)
1544# 600 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1545
1546# 600 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1547#endif
1548 do i = 1, num_species
1549 rhoyks(i) = qk_cons_vf(eqn_idx%species%beg + i - 1)%sf(j, k, l)
1550 end do
1551
1552 t = q_t_sf%sf(j, k, l)
1553 end if
1554
1555 if (mhd) then
1556 if (n == 0) then
1557 pres_mag = 0.5_wp*(bx0**2 + qk_cons_vf(eqn_idx%B%beg)%sf(j, k, &
1558 & l)**2 + qk_cons_vf(eqn_idx%B%beg + 1)%sf(j, k, l)**2)
1559 else
1560 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, &
1561 & l)**2 + qk_cons_vf(eqn_idx%B%beg + 2)%sf(j, k, l)**2)
1562 end if
1563 else
1564 pres_mag = 0._wp
1565 end if
1566
1567 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, &
1568 & pi_inf_k, gamma_k, rho_k, qv_k, rhoyks, pres, t, pres_mag=pres_mag)
1569
1570 qk_prim_vf(eqn_idx%E)%sf(j, k, l) = pres
1571
1572 if (chemistry) then
1573 q_t_sf%sf(j, k, l) = t
1574 end if
1575
1576 if (bubbles_euler) then
1577 ! Recover bubble primitive variables: divide conserved moments by bubble number density
1578
1579# 631 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1580#if defined(MFC_OpenACC)
1581# 631 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1582!$acc loop seq
1583# 631 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1584#elif defined(MFC_OpenMP)
1585# 631 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1586
1587# 631 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1588#endif
1589 do i = 1, nb
1590 nrtmp(i) = qk_cons_vf(bubrs_vc(i))%sf(j, k, l)
1591 end do
1592
1593 vftmp = qk_cons_vf(eqn_idx%alf)%sf(j, k, l)
1594
1595 if (qbmm) then
1596 ! Get nb (constant across all R0 bins)
1597 nbub_sc = qk_cons_vf(eqn_idx%bub%beg)%sf(j, k, l)
1598
1599 ! Convert cons to prim
1600
1601# 643 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1602#if defined(MFC_OpenACC)
1603# 643 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1604!$acc loop seq
1605# 643 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1606#elif defined(MFC_OpenMP)
1607# 643 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1608
1609# 643 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1610#endif
1611 do i = eqn_idx%bub%beg, eqn_idx%bub%end
1612 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)/nbub_sc
1613 end do
1614 ! Need to keep track of nb in the primitive variable list (converted back to true value before output)
1615 if (preserve_qbmm_number_vc) then
1616 qk_prim_vf(eqn_idx%bub%beg)%sf(j, k, l) = qk_cons_vf(eqn_idx%bub%beg)%sf(j, k, l)
1617 end if
1618 else
1619 if (adv_n) then
1620 qk_prim_vf(eqn_idx%n)%sf(j, k, l) = qk_cons_vf(eqn_idx%n)%sf(j, k, l)
1621 nbub_sc = qk_prim_vf(eqn_idx%n)%sf(j, k, l)
1622 else
1623 call s_comp_n_from_cons(vftmp, nrtmp, nbub_sc, weight)
1624 end if
1625
1626
1627# 659 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1628#if defined(MFC_OpenACC)
1629# 659 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1630!$acc loop seq
1631# 659 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1632#elif defined(MFC_OpenMP)
1633# 659 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1634
1635# 659 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1636#endif
1637 do i = eqn_idx%bub%beg, eqn_idx%bub%end
1638 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)/nbub_sc
1639 end do
1640 end if
1641 end if
1642
1643 if (mhd) then
1644
1645# 667 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1646#if defined(MFC_OpenACC)
1647# 667 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1648!$acc loop seq
1649# 667 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1650#elif defined(MFC_OpenMP)
1651# 667 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1652
1653# 667 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1654#endif
1655 do i = eqn_idx%B%beg, eqn_idx%B%end
1656 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)
1657 end do
1658 end if
1659
1660 if (hypoelasticity) then
1661
1662# 674 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1663#if defined(MFC_OpenACC)
1664# 674 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1665!$acc loop seq
1666# 674 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1667#elif defined(MFC_OpenMP)
1668# 674 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1669
1670# 674 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1671#endif
1672 do i = eqn_idx%stress%beg, eqn_idx%stress%end
1673 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)/rho_k
1674 end do
1675 end if
1676
1677 if (hypoelasticity) then
1678 if (cont_damage) g_k = g_k*max((1._wp - qk_cons_vf(eqn_idx%damage)%sf(j, k, l)), 0._wp)
1679
1680# 682 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1681#if defined(MFC_OpenACC)
1682# 682 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1683!$acc loop seq
1684# 682 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1685#elif defined(MFC_OpenMP)
1686# 682 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1687
1688# 682 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1689#endif
1690 do i = eqn_idx%stress%beg, eqn_idx%stress%end
1691 ! Elastic energy subtraction (guard skips when G near zero from alpha undershoot)
1692 if (g_k > verysmall) then
1693 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, &
1694 & l)**2._wp)/max(4._wp*g_k, verysmall))/gamma_k
1695 ! Double for shear stresses
1696 if (any(i == shear_indices)) then
1697 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, &
1698 & k, l)**2._wp)/max(4._wp*g_k, verysmall))/gamma_k
1699 end if
1700 end if
1701 end do
1702 end if
1703
1704 if (.not. igr .or. num_fluids > 1) then
1705
1706# 698 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1707#if defined(MFC_OpenACC)
1708# 698 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1709!$acc loop seq
1710# 698 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1711#elif defined(MFC_OpenMP)
1712# 698 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1713
1714# 698 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1715#endif
1716 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1717 qk_prim_vf(i)%sf(j, k, l) = qk_cons_vf(i)%sf(j, k, l)
1718 end do
1719 end if
1720
1721 if (surface_tension) then
1722 qk_prim_vf(eqn_idx%c)%sf(j, k, l) = qk_cons_vf(eqn_idx%c)%sf(j, k, l)
1723 end if
1724
1725 if (cont_damage) qk_prim_vf(eqn_idx%damage)%sf(j, k, l) = qk_cons_vf(eqn_idx%damage)%sf(j, k, l)
1726
1727 if (hyper_cleaning) qk_prim_vf(eqn_idx%psi)%sf(j, k, l) = qk_cons_vf(eqn_idx%psi)%sf(j, k, l)
1728 if (bubbles_lagrange .and. lagrange_beta_index_vc > 0) then
1729 qk_prim_vf(lagrange_beta_index_vc)%sf(j, k, l) = qk_cons_vf(lagrange_beta_index_vc)%sf(j, k, l)
1730 end if
1731 end do
1732 end do
1733 end do
1734
1735# 717 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1736#if defined(MFC_OpenACC)
1737# 717 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1738!$acc end parallel loop
1739# 717 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1740#elif defined(MFC_OpenMP)
1741# 717 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1742
1743# 717 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1744!$omp end target teams loop
1745# 717 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1746#endif
1747
1748 end subroutine s_convert_conservative_to_primitive_variables
1749
1750 !> Convert primitives (rho, u, p, alpha) to conserved variables (rho*alpha, rho*u, E, alpha).
1751 impure subroutine s_convert_primitive_to_conservative_variables(q_prim_vf, q_cons_vf)
1752
1753 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
1754 type(scalar_field), dimension(sys_size), intent(inout) :: q_cons_vf
1755
1756 ! Density, specific heat ratio function, liquid stiffness function and dynamic pressure, as defined in the incompressible
1757 ! flow sense, respectively
1758 real(wp) :: rho
1759 real(wp) :: gamma
1760 real(wp) :: pi_inf
1761 real(wp) :: qv
1762 real(wp) :: dyn_pres
1763 real(wp) :: nbub, r3tmp
1764 real(wp), dimension(nb) :: rtmp
1765 real(wp) :: g
1766 real(wp), dimension(2) :: re_k
1767 integer :: i, j, k, l !< Generic loop iterators
1768 real(wp), dimension(num_species) :: ys
1769 real(wp) :: e_mix, mix_mol_weight, t
1770 real(wp) :: pres_mag
1771 real(wp) :: ga !< Lorentz factor (gamma in relativity)
1772 real(wp) :: h !< relativistic enthalpy
1773 real(wp) :: v2 !< Square of the velocity magnitude
1774 real(wp) :: b2 !< Square of the magnetic field magnitude
1775 real(wp) :: vdotb !< Dot product of the velocity and magnetic field vectors
1776 real(wp) :: b(3) !< Magnetic field components
1777
1778 pres_mag = 0._wp
1779
1780 g = 0._wp
1781
1782 ! Converting the primitive variables to the conservative variables
1783 do l = 0, p
1784 do k = 0, n
1785 do j = 0, m
1786 ! Obtaining the density, specific heat ratio function and the liquid stiffness function, respectively
1787 call s_convert_to_mixture_variables(q_prim_vf, j, k, l, rho, gamma, pi_inf, qv, re_k, g, fluid_pp(:)%G)
1788
1789 if (.not. igr .or. num_fluids > 1) then
1790 ! Transferring the advection equation(s) variable(s)
1791 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1792 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
1793 end do
1794 end if
1795
1796 if (relativity) then
1797 if (n == 0) then
1798 b(1) = bx0
1799 b(2) = q_prim_vf(eqn_idx%B%beg)%sf(j, k, l)
1800 b(3) = q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l)
1801 else
1802 b(1) = q_prim_vf(eqn_idx%B%beg)%sf(j, k, l)
1803 b(2) = q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l)
1804 b(3) = q_prim_vf(eqn_idx%B%beg + 2)%sf(j, k, l)
1805 end if
1806
1807 v2 = 0._wp
1808 do i = eqn_idx%mom%beg, eqn_idx%mom%end
1809 v2 = v2 + q_prim_vf(i)%sf(j, k, l)**2
1810 end do
1811 if (v2 >= 1._wp) call s_mpi_abort('Error: v squared > 1 in s_convert_primitive_to_conservative_variables')
1812
1813 ga = 1._wp/sqrt(1._wp - v2)
1814
1815 h = 1._wp + (gamma + 1)*q_prim_vf(eqn_idx%E)%sf(j, k, l)/rho ! Assume perfect gas for now
1816
1817 b2 = 0._wp
1818 do i = eqn_idx%B%beg, eqn_idx%B%end
1819 b2 = b2 + q_prim_vf(i)%sf(j, k, l)**2
1820 end do
1821 if (n == 0) b2 = b2 + bx0**2
1822
1823 vdotb = 0._wp
1824 do i = 1, 3
1825 vdotb = vdotb + q_prim_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)*b(i)
1826 end do
1827
1828 do i = 1, eqn_idx%cont%end
1829 q_cons_vf(i)%sf(j, k, l) = ga*q_prim_vf(i)%sf(j, k, l)
1830 end do
1831
1832 do i = eqn_idx%mom%beg, eqn_idx%mom%end
1833 q_cons_vf(i)%sf(j, k, l) = (rho*h*ga**2 + b2)*q_prim_vf(i)%sf(j, k, &
1834 & l) - vdotb*b(i - eqn_idx%mom%beg + 1)
1835 end do
1836
1837 q_cons_vf(eqn_idx%E)%sf(j, k, l) = rho*h*ga**2 - q_prim_vf(eqn_idx%E)%sf(j, k, &
1838 & l) + 0.5_wp*(b2 + v2*b2 - vdotb**2)
1839 ! Remove rest energy
1840 do i = 1, eqn_idx%cont%end
1841 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)
1842 end do
1843
1844 do i = eqn_idx%B%beg, eqn_idx%B%end
1845 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
1846 end do
1847
1848 cycle ! skip all the non-relativistic conversions below
1849 end if
1850
1851 ! Transferring the continuity equation(s) variable(s)
1852 do i = 1, eqn_idx%cont%end
1853 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
1854 end do
1855
1856 ! Zeroing out the dynamic pressure since it is computed iteratively by cycling through the velocity equations
1857 dyn_pres = 0._wp
1858
1859 ! Computing momenta and dynamic pressure from velocity
1860 do i = eqn_idx%mom%beg, eqn_idx%mom%end
1861 q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l)
1862 dyn_pres = dyn_pres + q_cons_vf(i)%sf(j, k, l)*q_prim_vf(i)%sf(j, k, l)/2._wp
1863 end do
1864
1865 if (chemistry) then
1866 ! Reacting mixture: compute conserved energy from species mass fractions and temperature
1867 do i = eqn_idx%species%beg, eqn_idx%species%end
1868 ys(i - eqn_idx%species%beg + 1) = q_prim_vf(i)%sf(j, k, l)
1869 q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l)
1870 end do
1871
1872 call get_mixture_molecular_weight(ys, mix_mol_weight)
1873 t = q_prim_vf(eqn_idx%E)%sf(j, k, l)*mix_mol_weight/(gas_constant*rho)
1874 call get_mixture_energy_mass(t, ys, e_mix)
1875
1876 q_cons_vf(eqn_idx%E)%sf(j, k, l) = dyn_pres + rho*e_mix
1877 else
1878 ! Computing the energy from the pressure
1879 if (mhd) then
1880 if (n == 0) then
1881 pres_mag = 0.5_wp*(bx0**2 + q_prim_vf(eqn_idx%B%beg)%sf(j, k, &
1882 & l)**2 + q_prim_vf(eqn_idx%B%beg + 1)%sf(j, k, l)**2)
1883 else
1884 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, &
1885 & k, l)**2 + q_prim_vf(eqn_idx%B%beg + 2)%sf(j, k, l)**2)
1886 end if
1887 ! MHD energy includes magnetic pressure contribution
1888 q_cons_vf(eqn_idx%E)%sf(j, k, l) = gamma*q_prim_vf(eqn_idx%E)%sf(j, k, &
1889 & l) + dyn_pres + pres_mag + pi_inf + qv
1890 else if (bubbles_euler .neqv. .true.) then
1891 ! Five-equation model (Allaire et al. JCP 2002): E = Gamma*p + 0.5*rho*|u|^2 + pi_inf + qv
1892 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
1893 else
1894 ! Bubble-augmented energy with void fraction correction
1895 q_cons_vf(eqn_idx%E)%sf(j, k, l) = dyn_pres + (1._wp - q_prim_vf(eqn_idx%alf)%sf(j, k, &
1896 & l))*(gamma*q_prim_vf(eqn_idx%E)%sf(j, k, l) + pi_inf)
1897 end if
1898 end if
1899
1900 ! Six-equation model (Saurel et al. JCP 2009): compute per-phase internal energies
1901 if (model_eqns == model_eqns_6eq) then
1902 do i = 1, num_fluids
1903 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, &
1904 & l)*(gammas(i)*q_prim_vf(eqn_idx%E)%sf(j, k, &
1905 & l) + pi_infs(i)) + q_cons_vf(i + eqn_idx%cont%beg - 1)%sf(j, k, l)*qvs(i)
1906 end do
1907 end if
1908
1909 if (bubbles_euler) then
1910 ! From prim: Compute nbub = (3/4pi) * \alpha / \bar{R^3}
1911 do i = 1, nb
1912 rtmp(i) = q_prim_vf(qbmm_idx%rs(i))%sf(j, k, l)
1913 end do
1914
1915 if (.not. qbmm) then
1916 if (adv_n) then
1917 q_cons_vf(eqn_idx%n)%sf(j, k, l) = q_prim_vf(eqn_idx%n)%sf(j, k, l)
1918 nbub = q_prim_vf(eqn_idx%n)%sf(j, k, l)
1919 else
1920 call s_comp_n_from_prim(real(q_prim_vf(eqn_idx%alf)%sf(j, k, l), kind=wp), rtmp, nbub, weight)
1921 end if
1922 else
1923 ! Initialize R3 averaging over R0 and R directions
1924 r3tmp = 0._wp
1925 do i = 1, nb
1926 r3tmp = r3tmp + weight(i)*0.5_wp*(rtmp(i) + sigr)**3._wp
1927 r3tmp = r3tmp + weight(i)*0.5_wp*(rtmp(i) - sigr)**3._wp
1928 end do
1929 ! Initialize nb
1930 nbub = 3._wp*q_prim_vf(eqn_idx%alf)%sf(j, k, l)/(4._wp*pi*r3tmp)
1931 end if
1932
1933 do i = eqn_idx%bub%beg, eqn_idx%bub%end
1934 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)*nbub
1935 end do
1936 end if
1937
1938 if (mhd) then
1939 do i = eqn_idx%B%beg, eqn_idx%B%end
1940 q_cons_vf(i)%sf(j, k, l) = q_prim_vf(i)%sf(j, k, l)
1941 end do
1942 end if
1943
1944 if (hypoelasticity) then
1945 ! adding the elastic contribution Multiply \tau to \rho \tau
1946 do i = eqn_idx%stress%beg, eqn_idx%stress%end
1947 q_cons_vf(i)%sf(j, k, l) = rho*q_prim_vf(i)%sf(j, k, l)
1948 end do
1949 end if
1950
1951 if (hypoelasticity) then
1952 if (cont_damage) g = g*max((1._wp - q_prim_vf(eqn_idx%damage)%sf(j, k, l)), 0._wp)
1953 do i = eqn_idx%stress%beg, eqn_idx%stress%end
1954 ! Elastic energy addition (guard skips when G near zero from alpha undershoot)
1955 if (g > verysmall) then
1956 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, &
1957 & l)**2._wp)/max(4._wp*g, verysmall)
1958 ! Double for shear stresses
1959 if (any(i == shear_indices)) then
1960 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, &
1961 & l)**2._wp)/max(4._wp*g, verysmall)
1962 end if
1963 end if
1964 end do
1965 end if
1966
1967 if (surface_tension) then
1968 q_cons_vf(eqn_idx%c)%sf(j, k, l) = q_prim_vf(eqn_idx%c)%sf(j, k, l)
1969 end if
1970
1971 if (cont_damage) q_cons_vf(eqn_idx%damage)%sf(j, k, l) = q_prim_vf(eqn_idx%damage)%sf(j, k, l)
1972
1973 if (hyper_cleaning) q_cons_vf(eqn_idx%psi)%sf(j, k, l) = q_prim_vf(eqn_idx%psi)%sf(j, k, l)
1974 end do
1975 end do
1976 end do
1977
1978 end subroutine s_convert_primitive_to_conservative_variables
1979
1980 !> Convert primitive variables to Eulerian flux variables.
1981 subroutine s_convert_primitive_to_flux_variables(qK_prim_vf, FK_vf, FK_src_vf, is1, is2, is3, s2b, s3b, dir_idx_in, &
1982 & dir_flg_in, hll_u_interface_in)
1983
1984 integer, intent(in) :: s2b, s3b
1985 !> Working-direction mapping, passed explicitly: it is simulation state (m_global_parameters), and use-associating it into
1986 !! this common kernel spills registers on AMD OpenMP offload.
1987 integer, dimension(3), intent(in) :: dir_idx_in
1988 real(wp), dimension(3), intent(in) :: dir_flg_in
1989 logical, intent(in) :: hll_u_interface_in
1990 real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(in) :: qk_prim_vf
1991 real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: fk_vf
1992 real(wp), dimension(0:,idwbuff(2)%beg:,idwbuff(3)%beg:,eqn_idx%adv%beg:), intent(inout) :: fk_src_vf
1993 type(int_bounds_info), intent(in) :: is1, is2, is3
1994
1995 ! Partial densities, density, velocity, pressure, energy, advection variables, the specific heat ratio and liquid stiffness
1996 ! functions, the shear and volume Reynolds numbers and the Weber numbers
1997
1998# 975 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
1999 real(wp), dimension(num_fluids) :: alpha_rho_k
2000 real(wp), dimension(num_fluids) :: alpha_k
2001 real(wp), dimension(num_vels) :: vel_k
2002 real(wp), dimension(num_species) :: y_k
2003# 980 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2004 real(wp) :: rho_k
2005 real(wp) :: vel_k_sum
2006 real(wp) :: pres_k
2007 real(wp) :: e_k
2008 real(wp) :: gamma_k
2009 real(wp) :: pi_inf_k
2010 real(wp) :: qv_k
2011 real(wp), dimension(2) :: re_k
2012 real(wp) :: g_k
2013 real(wp) :: blkmod1_k, blkmod2_k, k_k
2014 real(wp) :: t_k, mix_mol_weight, r_gas
2015 integer :: i, j, k, l !< Generic loop iterators
2016
2017 is1b = is1%beg; is1e = is1%end
2018 is2b = is2%beg; is2e = is2%end
2019 is3b = is3%beg; is3e = is3%end
2020
2021
2022# 997 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2023#if defined(MFC_OpenACC)
2024# 997 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2025!$acc update device(is1b, is2b, is3b, is1e, is2e, is3e)
2026# 997 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2027#elif defined(MFC_OpenMP)
2028# 997 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2029!$omp target update to(is1b, is2b, is3b, is1e, is2e, is3e)
2030# 997 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2031#endif
2032
2033 ! Computing the flux variables from the primitive variables, without accounting for the contribution of either viscosity or
2034 ! capillarity
2035
2036# 1001 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2037
2038# 1001 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2039#if defined(MFC_OpenACC)
2040# 1001 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2041!$acc parallel loop collapse(3) gang vector default(present) &
2042# 1001 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2043!$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) &
2044# 1001 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2045!$acc& copyin(dir_idx_in, dir_flg_in, hll_u_interface_in)
2046# 1001 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2047#elif defined(MFC_OpenMP)
2048# 1001 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2049
2050# 1001 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2051
2052# 1001 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2053
2054# 1001 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2055!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) &
2056# 1001 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2057!$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) &
2058# 1001 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2059!$omp& map(to:dir_idx_in, dir_flg_in, hll_u_interface_in)
2060# 1001 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2061#endif
2062# 1004 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2063 do l = is3b, is3e
2064 do k = is2b, is2e
2065 do j = is1b, is1e
2066
2067# 1007 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2068#if defined(MFC_OpenACC)
2069# 1007 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2070!$acc loop seq
2071# 1007 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2072#elif defined(MFC_OpenMP)
2073# 1007 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2074
2075# 1007 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2076#endif
2077 do i = 1, eqn_idx%cont%end
2078 alpha_rho_k(i) = qk_prim_vf(j, k, l, i)
2079 end do
2080
2081
2082# 1012 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2083#if defined(MFC_OpenACC)
2084# 1012 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2085!$acc loop seq
2086# 1012 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2087#elif defined(MFC_OpenMP)
2088# 1012 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2089
2090# 1012 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2091#endif
2092 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2093 alpha_k(i - eqn_idx%E) = qk_prim_vf(j, k, l, i)
2094 end do
2095
2096
2097# 1017 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2098#if defined(MFC_OpenACC)
2099# 1017 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2100!$acc loop seq
2101# 1017 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2102#elif defined(MFC_OpenMP)
2103# 1017 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2104
2105# 1017 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2106#endif
2107 do i = 1, num_vels
2108 vel_k(i) = qk_prim_vf(j, k, l, eqn_idx%cont%end + i)
2109 end do
2110
2111 vel_k_sum = 0._wp
2112
2113# 1023 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2114#if defined(MFC_OpenACC)
2115# 1023 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2116!$acc loop seq
2117# 1023 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2118#elif defined(MFC_OpenMP)
2119# 1023 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2120
2121# 1023 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2122#endif
2123 do i = 1, num_vels
2124 vel_k_sum = vel_k_sum + vel_k(i)**2._wp
2125 end do
2126
2127 pres_k = qk_prim_vf(j, k, l, eqn_idx%E)
2128 if (hypoelasticity) then
2129 call s_convert_species_to_mixture_variables_kernel(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, alpha_rho_k, &
2130 & re_k, g_k, gs_vc)
2131 else
2132 call s_convert_species_to_mixture_variables_kernel(rho_k, gamma_k, pi_inf_k, qv_k, alpha_k, alpha_rho_k, &
2133 & re_k)
2134 end if
2135
2136 ! Computing the energy from the pressure
2137
2138 if (chemistry) then
2139
2140# 1040 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2141#if defined(MFC_OpenACC)
2142# 1040 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2143!$acc loop seq
2144# 1040 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2145#elif defined(MFC_OpenMP)
2146# 1040 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2147
2148# 1040 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2149#endif
2150 do i = eqn_idx%species%beg, eqn_idx%species%end
2151 y_k(i - eqn_idx%species%beg + 1) = qk_prim_vf(j, k, l, i)
2152 end do
2153 ! Computing the energy from the internal energy of the mixture
2154 call get_mixture_molecular_weight(y_k, mix_mol_weight)
2155 r_gas = gas_constant/mix_mol_weight
2156 t_k = pres_k/rho_k/r_gas
2157 call get_mixture_energy_mass(t_k, y_k, e_k)
2158 e_k = rho_k*e_k + 5.e-1_wp*rho_k*vel_k_sum
2159 else
2160 ! Computing the energy from the pressure
2161 e_k = gamma_k*pres_k + pi_inf_k + 5.e-1_wp*rho_k*vel_k_sum + qv_k
2162 end if
2163
2164 ! mass flux, this should be \alpha_i \rho_i u_i
2165
2166# 1056 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2167#if defined(MFC_OpenACC)
2168# 1056 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2169!$acc loop seq
2170# 1056 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2171#elif defined(MFC_OpenMP)
2172# 1056 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2173
2174# 1056 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2175#endif
2176 do i = 1, eqn_idx%cont%end
2177 fk_vf(j, k, l, i) = alpha_rho_k(i)*vel_k(dir_idx_in(1))
2178 end do
2179
2180
2181# 1061 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2182#if defined(MFC_OpenACC)
2183# 1061 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2184!$acc loop seq
2185# 1061 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2186#elif defined(MFC_OpenMP)
2187# 1061 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2188
2189# 1061 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2190#endif
2191 do i = 1, num_vels
2192 fk_vf(j, k, l, &
2193 & eqn_idx%cont%end + dir_idx_in(i)) = rho_k*vel_k(dir_idx_in(1))*vel_k(dir_idx_in(i)) &
2194 & + pres_k*dir_flg_in(dir_idx_in(i))
2195 end do
2196
2197 ! energy flux, u(E+p)
2198 fk_vf(j, k, l, eqn_idx%E) = vel_k(dir_idx_in(1))*(e_k + pres_k)
2199
2200 ! Species advection Flux, \rho*u*Y
2201 if (chemistry) then
2202
2203# 1073 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2204#if defined(MFC_OpenACC)
2205# 1073 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2206!$acc loop seq
2207# 1073 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2208#elif defined(MFC_OpenMP)
2209# 1073 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2210
2211# 1073 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2212#endif
2213 do i = 1, num_species
2214 fk_vf(j, k, l, i - 1 + eqn_idx%species%beg) = vel_k(dir_idx_in(1))*(rho_k*y_k(i))
2215 end do
2216 end if
2217
2218 ! Match the volume-fraction flux representation exported by the Riemann solver. HLL Method 1: zero alpha
2219 ! flux plus per-fluid interface-alpha source traces. Hypoelastic HLLD folds every non-conservative term
2220 ! into its augmented flux (adv_src_mode_none), so its source trace is zero; for this cell-local conversion
2221 ! the fold collapses exactly to -/+ K*u_n on the two volume-fraction rows (K = 0 without alt_soundspeed),
2222 ! with the same two-fluid longitudinal-modulus K as the HLLD kernel (num_fluids = 2 is checker-enforced).
2223 ! MHD HLLD keeps the per-fluid-trace representation it has always used. HLL Method 2, HLLC, and LF use the
2224 ! shared-velocity representation below.
2225 if (riemann_solver == riemann_solver_hlld) then
2226 if (hypoelasticity) then
2227 k_k = 0._wp
2228 ! The fluid-2 subscripts must not be compiled when case optimization
2229 ! bakes num_fluids = 1 (amdflang rejects them at compile time); the
2230 ! checker prohibits hypoelastic HLLD there, so the block is dead code.
2231# 1093 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2232 if (alt_soundspeed) then
2233 blkmod1_k = ((gammas(1) + 1._wp)*pres_k + pi_infs(1))/gammas(1) + (4._wp/3._wp)*gs_vc(1)
2234 blkmod2_k = ((gammas(2) + 1._wp)*pres_k + pi_infs(2))/gammas(2) + (4._wp/3._wp)*gs_vc(2)
2235 k_k = alpha_k(1)*alpha_k(2)*(blkmod2_k - blkmod1_k)/(alpha_k(1)*blkmod2_k + alpha_k(2) &
2236 & *blkmod1_k + verysmall)
2237 end if
2238# 1100 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2239
2240# 1100 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2241#if defined(MFC_OpenACC)
2242# 1100 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2243!$acc loop seq
2244# 1100 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2245#elif defined(MFC_OpenMP)
2246# 1100 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2247
2248# 1100 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2249#endif
2250 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2251 fk_vf(j, k, l, i) = 0._wp
2252 fk_src_vf(j, k, l, i) = 0._wp
2253 end do
2254 fk_vf(j, k, l, eqn_idx%adv%beg) = -k_k*vel_k(dir_idx_in(1))
2255 fk_vf(j, k, l, eqn_idx%adv%end) = k_k*vel_k(dir_idx_in(1))
2256 else
2257
2258# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2259#if defined(MFC_OpenACC)
2260# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2261!$acc loop seq
2262# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2263#elif defined(MFC_OpenMP)
2264# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2265
2266# 1108 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2267#endif
2268 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2269 fk_vf(j, k, l, i) = 0._wp
2270 fk_src_vf(j, k, l, i) = alpha_k(i - eqn_idx%E)
2271 end do
2272 end if
2273 else if (riemann_solver == riemann_solver_hll .and. .not. hll_u_interface_in) then
2274
2275# 1115 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2276#if defined(MFC_OpenACC)
2277# 1115 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2278!$acc loop seq
2279# 1115 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2280#elif defined(MFC_OpenMP)
2281# 1115 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2282
2283# 1115 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2284#endif
2285 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2286 fk_vf(j, k, l, i) = 0._wp
2287 fk_src_vf(j, k, l, i) = alpha_k(i - eqn_idx%E)
2288 end do
2289 else
2290 ! Could be bubbles_euler!
2291
2292# 1122 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2293#if defined(MFC_OpenACC)
2294# 1122 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2295!$acc loop seq
2296# 1122 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2297#elif defined(MFC_OpenMP)
2298# 1122 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2299
2300# 1122 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2301#endif
2302 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2303 fk_vf(j, k, l, i) = vel_k(dir_idx_in(1))*alpha_k(i - eqn_idx%E)
2304 end do
2305
2306
2307# 1127 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2308#if defined(MFC_OpenACC)
2309# 1127 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2310!$acc loop seq
2311# 1127 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2312#elif defined(MFC_OpenMP)
2313# 1127 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2314
2315# 1127 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2316#endif
2317 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2318 fk_src_vf(j, k, l, i) = vel_k(dir_idx_in(1))
2319 end do
2320 end if
2321 end do
2322 end do
2323 end do
2324
2325# 1135 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2326#if defined(MFC_OpenACC)
2327# 1135 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2328!$acc end parallel loop
2329# 1135 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2330#elif defined(MFC_OpenMP)
2331# 1135 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2332
2333# 1135 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2334!$omp end target teams loop
2335# 1135 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2336#endif
2337
2338 end subroutine s_convert_primitive_to_flux_variables
2339
2340 !> Compute partial densities and volume fractions
2341 subroutine s_compute_species_fraction(q_vf, k, l, r, alpha_rho_K, alpha_K)
2342
2343
2344# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2345#ifdef _CRAYFTN
2346# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2347#if MFC_OpenACC
2348# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2349!$acc routine seq
2350# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2351#elif MFC_OpenMP
2352# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2353
2354# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2355
2356# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2357!$omp declare target device_type(any)
2358# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2359#else
2360# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2361!DIR$ NOINLINE s_compute_species_fraction
2362# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2363#endif
2364# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2365#elif MFC_OpenACC
2366# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2367!$acc routine seq
2368# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2369#elif MFC_OpenMP
2370# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2371
2372# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2373
2374# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2375!$omp declare target device_type(any)
2376# 1142 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2377#endif
2378 type(scalar_field), dimension(sys_size), intent(in) :: q_vf
2379 integer, intent(in) :: k, l, r
2380# 1148 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2381 real(wp), dimension(num_fluids), intent(out) :: alpha_rho_k, alpha_k
2382# 1150 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2383 integer :: i
2384 real(wp) :: alpha_k_sum
2385
2386 if (num_fluids == 1) then
2387 alpha_rho_k(1) = q_vf(eqn_idx%cont%beg)%sf(k, l, r)
2388 if (igr .or. bubbles_euler) then
2389 alpha_k(1) = 1._wp
2390 else
2391 alpha_k(1) = q_vf(eqn_idx%adv%beg)%sf(k, l, r)
2392 end if
2393 else
2394 if (igr) then
2395 do i = 1, num_fluids - 1
2396 alpha_rho_k(i) = q_vf(i)%sf(k, l, r)
2397 alpha_k(i) = q_vf(eqn_idx%adv%beg + i - 1)%sf(k, l, r)
2398 end do
2399 alpha_rho_k(num_fluids) = q_vf(num_fluids)%sf(k, l, r)
2400 alpha_k(num_fluids) = 1._wp - sum(alpha_k(1:num_fluids - 1))
2401 else
2402 do i = 1, num_fluids
2403 alpha_rho_k(i) = q_vf(i)%sf(k, l, r)
2404 alpha_k(i) = q_vf(eqn_idx%adv%beg + i - 1)%sf(k, l, r)
2405 end do
2406 end if
2407 end if
2408
2409 if (mpp_lim) then
2410 alpha_k_sum = 0._wp
2411 do i = 1, num_fluids
2412 alpha_rho_k(i) = max(0._wp, alpha_rho_k(i))
2413 alpha_k(i) = min(max(0._wp, alpha_k(i)), 1._wp)
2414 alpha_k_sum = alpha_k_sum + alpha_k(i)
2415 end do
2416 alpha_k = alpha_k/max(alpha_k_sum, 1.e-16_wp)
2417 end if
2418
2419 if (num_fluids == 1 .and. bubbles_euler) alpha_k(1) = q_vf(eqn_idx%adv%beg)%sf(k, l, r)
2420
2421 end subroutine s_compute_species_fraction
2422
2423 !> Deallocate fluid property arrays and post-processing fields allocated during module initialization.
2424 impure subroutine s_finalize_variables_conversion_module()
2425
2426 if (allocated(rho_sf)) deallocate (rho_sf, gamma_sf, pi_inf_sf, qv_sf)
2427
2428#ifdef MFC_DEBUG
2429# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2430 block
2431# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2432 use iso_fortran_env, only: output_unit
2433# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2434
2435# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2436 print *, 'm_variables_conversion.fpp:1195: ', '@:DEALLOCATE(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, Gs_vc)'
2437# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2438
2439# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2440 call flush (output_unit)
2441# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2442 end block
2443# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2444#endif
2445# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2446
2447# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2448#if defined(MFC_OpenACC)
2449# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2450!$acc exit data delete(gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, Gs_vc)
2451# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2452#elif defined(MFC_OpenMP)
2453# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2454!$omp target exit data map(release:gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, Gs_vc)
2455# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2456#endif
2457# 1195 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2458 deallocate (gammas, gs_min, pi_infs, ps_inf, cvs, qvs, qvps, gs_vc)
2459 if (allocated(bubrs_vc)) then
2460#ifdef MFC_DEBUG
2461# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2462 block
2463# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2464 use iso_fortran_env, only: output_unit
2465# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2466
2467# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2468 print *, 'm_variables_conversion.fpp:1197: ', '@:DEALLOCATE(bubrs_vc)'
2469# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2470
2471# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2472 call flush (output_unit)
2473# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2474 end block
2475# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2476#endif
2477# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2478
2479# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2480#if defined(MFC_OpenACC)
2481# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2482!$acc exit data delete(bubrs_vc)
2483# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2484#elif defined(MFC_OpenMP)
2485# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2486!$omp target exit data map(release:bubrs_vc)
2487# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2488#endif
2489# 1197 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2490 deallocate (bubrs_vc)
2491 end if
2492 if (allocated(res_vc)) then
2493#ifdef MFC_DEBUG
2494# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2495 block
2496# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2497 use iso_fortran_env, only: output_unit
2498# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2499
2500# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2501 print *, 'm_variables_conversion.fpp:1200: ', '@:DEALLOCATE(Res_vc)'
2502# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2503
2504# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2505 call flush (output_unit)
2506# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2507 end block
2508# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2509#endif
2510# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2511
2512# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2513#if defined(MFC_OpenACC)
2514# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2515!$acc exit data delete(Res_vc)
2516# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2517#elif defined(MFC_OpenMP)
2518# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2519!$omp target exit data map(release:Res_vc)
2520# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2521#endif
2522# 1200 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2523 deallocate (res_vc)
2524 end if
2525
2526 end subroutine s_finalize_variables_conversion_module
2527
2528 !> Compute the speed of sound from thermodynamic state variables, supporting multiple equation-of-state models.
2529 subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, H, adv, vel_sum, c_c, c, qv)
2530
2531
2532# 1208 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2533#if MFC_OpenACC
2534# 1208 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2535!$acc routine seq
2536# 1208 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2537#elif MFC_OpenMP
2538# 1208 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2539
2540# 1208 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2541
2542# 1208 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2543!$omp declare target device_type(any)
2544# 1208 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2545#endif
2546
2547 real(wp), intent(in) :: pres
2548 real(wp), intent(in) :: rho, gamma, pi_inf, qv
2549 real(wp), intent(in) :: h
2550# 1216 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2551 real(wp), dimension(num_fluids), intent(in) :: adv
2552# 1218 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2553 real(wp), intent(in) :: vel_sum
2554 real(wp), intent(in) :: c_c
2555 real(wp), intent(out) :: c
2556 real(wp) :: blkmod1, blkmod2
2557 integer :: q
2558
2559 if (chemistry) then ! Reacting mixture sound speed
2560 if (avg_state == avg_state_roe .and. abs(c_c) > verysmall) then
2561 c = sqrt(c_c - (gamma - 1.0_wp)*(vel_sum - h))
2562 else
2563 c = sqrt((1.0_wp + 1.0_wp/gamma)*pres/rho)
2564 end if
2565 else if (relativity) then ! Relativistic sound speed
2566 c = sqrt((1._wp + 1._wp/gamma)*pres/rho/h)
2567 else
2568 if (alt_soundspeed) then ! Wood's mixture sound speed via bulk moduli
2569 blkmod1 = ((gammas(1) + 1._wp)*pres + pi_infs(1))/gammas(1)
2570 blkmod2 = ((gammas(2) + 1._wp)*pres + pi_infs(2))/gammas(2)
2571 c = (1._wp/(rho*(adv(1)/blkmod1 + adv(2)/blkmod2)))
2572 else if (model_eqns == model_eqns_6eq) then ! Six-equation model sound speed
2573 c = 0._wp
2574
2575# 1239 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2576#if defined(MFC_OpenACC)
2577# 1239 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2578!$acc loop seq
2579# 1239 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2580#elif defined(MFC_OpenMP)
2581# 1239 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2582
2583# 1239 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2584#endif
2585 do q = 1, num_fluids
2586 c = c + adv(q)*gs_min(q)*(pres + pi_infs(q)/(gammas(q) + 1._wp))
2587 end do
2588 c = c/rho
2589 else if (model_eqns == model_eqns_5eq .and. bubbles_euler) then
2590 ! Sound speed for bubble mixture to order O(\alpha)
2591
2592 if (mpp_lim .and. (num_fluids > 1)) then
2593 c = (1._wp/gamma + 1._wp)*(pres + pi_inf/(gamma + 1._wp))/rho
2594 else
2595 c = (1._wp/gamma + 1._wp)*(pres + pi_inf/(gamma + 1._wp))/(rho*(1._wp - adv(num_fluids)))
2596 end if
2597 else
2598 c = (h - 5.e-1*vel_sum - qv/rho)/gamma
2599 end if
2600
2601 if (mixture_err .and. c < 0._wp) then
2602 c = 100._wp*sgm_eps
2603 else
2604 c = sqrt(c)
2605 end if
2606 end if
2607
2608 end subroutine s_compute_speed_of_sound
2609
2610 !> Compute the fast magnetosonic wave speed from the sound speed, density, and magnetic field components.
2611 subroutine s_compute_fast_magnetosonic_speed(rho, c, B, norm, c_fast, h)
2612
2613
2614# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2615#ifdef _CRAYFTN
2616# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2617#if MFC_OpenACC
2618# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2619!$acc routine seq
2620# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2621#elif MFC_OpenMP
2622# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2623
2624# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2625
2626# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2627!$omp declare target device_type(any)
2628# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2629#else
2630# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2631!DIR$ NOINLINE s_compute_fast_magnetosonic_speed
2632# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2633#endif
2634# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2635#elif MFC_OpenACC
2636# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2637!$acc routine seq
2638# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2639#elif MFC_OpenMP
2640# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2641
2642# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2643
2644# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2645!$omp declare target device_type(any)
2646# 1268 "/home/runner/work/MFC/MFC/src/common/m_variables_conversion.fpp"
2647#endif
2648
2649 real(wp), intent(in) :: b(3), rho, c
2650 real(wp), intent(in) :: h !< only used for relativity
2651 real(wp), intent(out) :: c_fast
2652 integer, intent(in) :: norm
2653 real(wp) :: b2, term, disc
2654
2655 b2 = sum(b**2)
2656
2657 if (.not. relativity) then
2658 term = c**2 + b2/rho
2659 disc = term**2 - 4*c**2*(b(norm)**2/rho)
2660 else
2661 ! Note: this is approximation for the non-relatisitic limit; accurate solution requires solving a quartic equation
2662 term = (c**2*(b(norm)**2 + rho*h) + b2)/(rho*h + b2)
2663 disc = term**2 - 4*c**2*b(norm)**2/(rho*h + b2)
2664 end if
2665
2666#ifdef MFC_DEBUG
2667 if (disc < 0._wp) then
2668 print *, 'rho, c, Bx, By, Bz, h, term, disc:', rho, c, b(1), b(2), b(3), h, term, disc
2669 ! s_mpi_abort is a host routine and cannot be called from device code
2670 ! (this is a GPU routine); on GPU builds, emit the diagnostic print only.
2671#ifndef MFC_GPU
2672 call s_mpi_abort('Error: negative discriminant in s_compute_fast_magnetosonic_speed')
2673#endif
2674 end if
2675#endif
2676
2677 c_fast = sqrt(0.5_wp*(term + sqrt(disc)))
2678
2679 end subroutine s_compute_fast_magnetosonic_speed
2680
2681end 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
Defines global parameters for the computational domain, simulation algorithm, and initial conditions.
Definition m_global_parameters.fpp.f90:19
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:323
m_helper
Utility routines for bubble model setup, coordinate transforms, array sampling, and special functions...
Definition m_helper.fpp.f90:334
m_mpi_proxy
Broadcasts user inputs and decomposes the domain across MPI ranks for pre-processing.
Definition m_mpi_proxy.fpp.f90:7
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:334
m_variables_conversion::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:2342
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:2425
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:2530
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:1752
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:1983
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:2612
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