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