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