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