MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_riemann_solvers.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2!>
3!! @file
4!! @brief Contains module m_riemann_solvers
5
6!> @brief Approximate and exact Riemann solvers (HLL, HLLC, HLLD, exact) for the multicomponent Navier--Stokes equations
7
8# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
9! This file exists so that Fypp can be run without generating case.fpp files for
10! each target. This is useful when generating documentation, for example. This
11! should also let MFC be built with CMake directly, without invoking mfc.sh.
12
13! For pre-process.
14# 9 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
15
16! For moving immersed boundaries in simulation
17# 14 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
18# 8 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp" 2
19# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
20# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
21# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
22# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
23# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
25# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
27
28# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31
32# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
33
34# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
35
36# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37
38# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39
40# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45! New line at end of file is required for FYPP
46# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
47# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
48# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
49# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54
55# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58
59# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60
61# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
62
63# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
64
65# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
66
67# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68
69# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
70
71# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
72! New line at end of file is required for FYPP
73# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
74
75# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
76# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
78# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
80
81# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
82
83# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
84
85# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
86
87# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
88
89# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90
91# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
92
93# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
94
95# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
96
97# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
98
99# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
100
101# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
102
103# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
104
105# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
106
107# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
108
109# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
110
111# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
112
113# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151! New line at end of file is required for FYPP
152# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
153# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
154# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
155# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
156# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160
161# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
164
165# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166
167# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
168
169# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170
171# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172
173# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
174
175# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176
177# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
178! New line at end of file is required for FYPP
179# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
180
181# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
182
183# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
184
185# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
186
187# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
188
189# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
190
191# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
192
193# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
194
195# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
196
197# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
198
199# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
200
201# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
202
203# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
204
205# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
206
207# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236! New line at end of file is required for FYPP
237# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
238
239! GPU parallel region (scalar reductions, maxval/minval)
240# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
241
242! GPU parallel loop over threads (most common GPU macro)
243# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
244
245! Required closing for GPU_PARALLEL_LOOP
246# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
247
248! Mark routine for device compilation
249# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
250
251! Declare device-resident data
252# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
253
254! Inner loop within a GPU parallel region
255# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
256
257! Scoped GPU data region
258# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
259
260! Host code with device pointers (for MPI with GPU buffers)
261# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
262
263! Allocate device memory (unscoped)
264# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
265
266! Free device memory
267# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
268
269! Atomic operation on device
270# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
271
272! End atomic capture block
273# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
274
275! Copy data between host and device
276# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
277
278! Synchronization barrier
279# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
280
281! Import GPU library module (openacc or omp_lib)
282# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
283
284! Emit code only for AMD compiler
285# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
286
287! Emit code for non-Cray compilers
288# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
289
290! Emit code only for Cray compiler
291# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
292
293! Emit code for non-NVIDIA compilers
294# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
295
296# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
298! New line at end of file is required for FYPP
299# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
300
301# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
302
303! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
304! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
305! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
306# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
307
308! Allocate and create GPU device memory
309# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
310
311! Free GPU device memory and deallocate
312# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
313
314! Cray-specific GPU pointer setup for vector fields
315# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
316
317! Cray-specific GPU pointer setup for scalar fields
318# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
319
320! Cray-specific GPU pointer setup for acoustic source spatials
321# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
322
323# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
324
325# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
326! New line at end of file is required for FYPP
327# 9 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp" 2
328# 1 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp" 1
329# 13 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
330
331# 83 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
332
333# 93 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
334
335# 117 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
336# 10 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp" 2
337
338module m_riemann_solvers
339
340 use m_derived_types
341 use m_global_parameters
342 use m_mpi_proxy
343 use m_variables_conversion
344 use m_bubbles
345 use m_bubbles_ee
346 use m_surface_tension
347 use m_helper_basic
348 use m_chemistry
349 use m_thermochem, only: gas_constant, get_mixture_molecular_weight, get_mixture_specific_heat_cv_mass, &
350 & get_mixture_energy_mass, get_species_specific_heats_r, get_species_enthalpies_rt, get_mixture_specific_heat_cp_mass
351
352# 28 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
353
354 implicit none
355
356 private; public :: s_initialize_riemann_solvers_module, s_riemann_solver, s_hll_riemann_solver, s_hllc_riemann_solver, &
357 & s_hlld_riemann_solver, s_lf_riemann_solver, s_finalize_riemann_solvers_module
358
359 !> The cell-boundary values of the fluxes (src - source) that are computed through the chosen Riemann problem solver, and the
360 !! direct evaluation of source terms, by using the left and right states given in qK_prim_rs_vf, dqK_prim_ds_vf where ds = dx,
361 !! dy or dz.
362 !> @{
363 real(wp), allocatable, dimension(:,:,:,:) :: flux_rsx_vf, flux_src_rsx_vf
364 real(wp), allocatable, dimension(:,:,:,:) :: flux_rsy_vf, flux_src_rsy_vf
365 real(wp), allocatable, dimension(:,:,:,:) :: flux_rsz_vf, flux_src_rsz_vf
366
367# 41 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
368#if defined(MFC_OpenACC)
369# 41 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
370!$acc declare create(flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf)
371# 41 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
372#elif defined(MFC_OpenMP)
373# 41 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
374!$omp declare target (flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf)
375# 41 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
376#endif
377 !> @}
378
379 !> The cell-boundary values of the geometrical source flux that are computed through the chosen Riemann problem solver by using
380 !! the left and right states given in qK_prim_rs_vf. Currently 2D axisymmetric for inviscid only.
381 !> @{
382 real(wp), allocatable, dimension(:,:,:,:) :: flux_gsrc_rsx_vf
383 real(wp), allocatable, dimension(:,:,:,:) :: flux_gsrc_rsy_vf
384 real(wp), allocatable, dimension(:,:,:,:) :: flux_gsrc_rsz_vf
385
386# 50 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
387#if defined(MFC_OpenACC)
388# 50 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
389!$acc declare create(flux_gsrc_rsx_vf, flux_gsrc_rsy_vf, flux_gsrc_rsz_vf)
390# 50 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
391#elif defined(MFC_OpenMP)
392# 50 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
393!$omp declare target (flux_gsrc_rsx_vf, flux_gsrc_rsy_vf, flux_gsrc_rsz_vf)
394# 50 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
395#endif
396 !> @}
397
398 ! Cell-boundary velocity from Riemann solution; used for source flux
399
400 real(wp), allocatable, dimension(:,:,:,:) :: vel_src_rsx_vf
401 real(wp), allocatable, dimension(:,:,:,:) :: vel_src_rsy_vf
402 real(wp), allocatable, dimension(:,:,:,:) :: vel_src_rsz_vf
403
404# 58 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
405#if defined(MFC_OpenACC)
406# 58 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
407!$acc declare create(vel_src_rsx_vf, vel_src_rsy_vf, vel_src_rsz_vf)
408# 58 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
409#elif defined(MFC_OpenMP)
410# 58 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
411!$omp declare target (vel_src_rsx_vf, vel_src_rsy_vf, vel_src_rsz_vf)
412# 58 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
413#endif
414
415 real(wp), allocatable, dimension(:,:,:,:) :: mom_sp_rsx_vf
416 real(wp), allocatable, dimension(:,:,:,:) :: mom_sp_rsy_vf
417 real(wp), allocatable, dimension(:,:,:,:) :: mom_sp_rsz_vf
418
419# 63 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
420#if defined(MFC_OpenACC)
421# 63 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
422!$acc declare create(mom_sp_rsx_vf, mom_sp_rsy_vf, mom_sp_rsz_vf)
423# 63 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
424#elif defined(MFC_OpenMP)
425# 63 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
426!$omp declare target (mom_sp_rsx_vf, mom_sp_rsy_vf, mom_sp_rsz_vf)
427# 63 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
428#endif
429
430 real(wp), allocatable, dimension(:,:,:,:) :: re_avg_rsx_vf
431 real(wp), allocatable, dimension(:,:,:,:) :: re_avg_rsy_vf
432 real(wp), allocatable, dimension(:,:,:,:) :: re_avg_rsz_vf
433
434# 68 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
435#if defined(MFC_OpenACC)
436# 68 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
437!$acc declare create(Re_avg_rsx_vf, Re_avg_rsy_vf, Re_avg_rsz_vf)
438# 68 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
439#elif defined(MFC_OpenMP)
440# 68 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
441!$omp declare target (Re_avg_rsx_vf, Re_avg_rsy_vf, Re_avg_rsz_vf)
442# 68 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
443#endif
444
445 !> @name Indical bounds in the s1-, s2- and s3-directions
446 !> @{
447 type(int_bounds_info) :: is1, is2, is3
448 type(int_bounds_info) :: isx, isy, isz
449 !> @}
450
451
452# 76 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
453#if defined(MFC_OpenACC)
454# 76 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
455!$acc declare create(is1, is2, is3, isx, isy, isz)
456# 76 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
457#elif defined(MFC_OpenMP)
458# 76 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
459!$omp declare target (is1, is2, is3, isx, isy, isz)
460# 76 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
461#endif
462
463 real(wp), allocatable, dimension(:) :: gs_rs
464
465# 79 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
466#if defined(MFC_OpenACC)
467# 79 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
468!$acc declare create(Gs_rs)
469# 79 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
470#elif defined(MFC_OpenMP)
471# 79 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
472!$omp declare target (Gs_rs)
473# 79 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
474#endif
475
476 real(wp), allocatable, dimension(:,:) :: res_gs
477
478# 82 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
479#if defined(MFC_OpenACC)
480# 82 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
481!$acc declare create(Res_gs)
482# 82 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
483#elif defined(MFC_OpenMP)
484# 82 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
485!$omp declare target (Res_gs)
486# 82 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
487#endif
488
489contains
490
491 !> Dispatch to the subroutines that are utilized to compute the Riemann problem solution. For additional information please
492 !! reference: 1) s_hll_riemann_solver 2) s_hllc_riemann_solver 3) s_lf_riemann_solver 4) s_hlld_riemann_solver
493 subroutine s_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, &
494
495 & qL_prim_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, &
496 & q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
497
498 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, ql_prim_rsy_vf, &
499 & qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf
500 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
501 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
502 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
503 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
504
505 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
506 integer, intent(in) :: norm_dir
507 type(int_bounds_info), intent(in) :: ix, iy, iz
508
509# 105 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
510 if (riemann_solver == 1) then
511 call s_hll_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, &
512 & dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, &
513 & dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, &
514 & flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
515 end if
516# 105 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
517 if (riemann_solver == 2) then
518 call s_hllc_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, &
519 & dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, &
520 & dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, &
521 & flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
522 end if
523# 105 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
524 if (riemann_solver == 4) then
525 call s_hlld_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, &
526 & dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, &
527 & dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, &
528 & flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
529 end if
530# 105 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
531 if (riemann_solver == 5) then
532 call s_lf_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, &
533 & dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, &
534 & dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, &
535 & flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
536 end if
537# 112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
538
539 end subroutine s_riemann_solver
540
541 !> Dispatch to the subroutines that are utilized to compute the viscous source fluxes for either Cartesian or cylindrical
542 !! geometries. For more information please refer to: 1) s_compute_cartesian_viscous_source_flux 2)
543 !! s_compute_cylindrical_viscous_source_flux
544 subroutine s_compute_viscous_source_flux(velL_vf, dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, velR_vf, dvelR_dx_vf, dvelR_dy_vf, &
545
546 & dvelR_dz_vf, flux_src_vf, norm_dir, ix, iy, iz)
547
548 type(scalar_field), dimension(num_vels), intent(in) :: velL_vf, velR_vf, dvelL_dx_vf, dvelR_dx_vf, dvelL_dy_vf, &
549 & dvelR_dy_vf, dvelL_dz_vf, dvelR_dz_vf
550
551 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
552 integer, intent(in) :: norm_dir
553 type(int_bounds_info), intent(in) :: ix, iy, iz
554
555 if (grid_geometry == 3) then
556 call s_compute_cylindrical_viscous_source_flux(vell_vf, dvell_dx_vf, dvell_dy_vf, dvell_dz_vf, velr_vf, dvelr_dx_vf, &
557 & dvelr_dy_vf, dvelr_dz_vf, flux_src_vf, norm_dir, ix, iy, iz)
558 else
559 call s_compute_cartesian_viscous_source_flux(dvell_dx_vf, dvell_dy_vf, dvell_dz_vf, dvelr_dx_vf, dvelr_dy_vf, &
560 & dvelr_dz_vf, flux_src_vf, norm_dir)
561 end if
562
563 end subroutine s_compute_viscous_source_flux
564
565 !> HLL approximate Riemann solver, Harten et al. SIAM Review (1983)
566 subroutine s_hll_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, &
567
568 & dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, &
569 & dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
570
571 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, ql_prim_rsy_vf, &
572 & qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf
573 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
574 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
575 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
576 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
577
578 ! Intercell fluxes
579 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
580 real(wp) :: flux_tau_l, flux_tau_r
581 integer, intent(in) :: norm_dir
582 type(int_bounds_info), intent(in) :: ix, iy, iz
583
584# 166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
585 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
586 real(wp), dimension(num_vels) :: vel_l, vel_r
587 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
588 real(wp), dimension(num_species) :: ys_l, ys_r
589 real(wp), dimension(num_species) :: cp_il, cp_ir, xs_l, xs_r, gamma_il, gamma_ir
590 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
591# 173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
592 real(wp) :: rho_l, rho_r
593 real(wp) :: pres_l, pres_r
594 real(wp) :: e_l, e_r
595 real(wp) :: h_l, h_r
596 real(wp) :: cp_avg, cv_avg, t_avg, eps, c_sum_yi_phi
597 real(wp) :: t_l, t_r
598 real(wp) :: y_l, y_r
599 real(wp) :: mw_l, mw_r
600 real(wp) :: r_gas_l, r_gas_r
601 real(wp) :: cp_l, cp_r
602 real(wp) :: cv_l, cv_r
603 real(wp) :: gamm_l, gamm_r
604 real(wp) :: gamma_l, gamma_r
605 real(wp) :: pi_inf_l, pi_inf_r
606 real(wp) :: qv_l, qv_r
607 real(wp) :: c_l, c_r
608 real(wp), dimension(6) :: tau_e_l, tau_e_r
609 real(wp) :: g_l, g_r
610 real(wp), dimension(2) :: re_l, re_r
611 real(wp), dimension(3) :: xi_field_l, xi_field_r
612 real(wp) :: rho_avg
613 real(wp) :: h_avg
614 real(wp) :: qv_avg
615 real(wp) :: gamma_avg
616 real(wp) :: c_avg
617 real(wp) :: s_l, s_r, s_m, s_p, s_s
618 real(wp) :: xi_m, xi_p
619 real(wp) :: ptilde_l, ptilde_r
620 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
621 real(wp) :: vel_l_tmp, vel_r_tmp
622 real(wp) :: ms_l, ms_r, pres_sl, pres_sr
623 real(wp) :: alpha_l_sum, alpha_r_sum
624 real(wp) :: zcoef, pcorr !< low Mach number correction
625 type(riemann_states) :: c_fast, pres_mag
626 type(riemann_states_vec3) :: b
627 type(riemann_states) :: ga !< Gamma (Lorentz factor)
628 type(riemann_states) :: vdotb, b2
629 type(riemann_states_vec3) :: b4 !< 4-magnetic field components (spatial: b4x, b4y, b4z)
630 type(riemann_states_vec3) :: cm !< Conservative momentum variables
631 integer :: i, j, k, l, q !< Generic loop iterators
632 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
633
634 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
635 & dql_prim_dy_vf, dql_prim_dz_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, &
636 & dqr_prim_dz_vf, norm_dir, ix, iy, iz)
637
638 ! Reshaping inputted data based on dimensional splitting direction
639 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
640# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
641 if (norm_dir == 1) then
642
643# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
644
645# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
646#if defined(MFC_OpenACC)
647# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
648!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, tau_e_L, tau_e_R, Re_L, Re_R, s_L, s_R, s_S, Ys_L, Ys_R, xi_field_L, xi_field_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, c_fast, pres_mag, B, Ga, vdotB, B2, b4, cm, pcorr, zcoef, vel_L_tmp, vel_R_tmp, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, flux_tau_L, flux_tau_R) copyin(norm_dir)
649# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
650#elif defined(MFC_OpenMP)
651# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
652
653# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
654
655# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
656
657# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
658!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, tau_e_L, tau_e_R, Re_L, Re_R, s_L, s_R, s_S, Ys_L, Ys_R, xi_field_L, xi_field_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, c_fast, pres_mag, B, Ga, vdotB, B2, b4, cm, pcorr, zcoef, vel_L_tmp, vel_R_tmp, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, flux_tau_L, flux_tau_R) map(to:norm_dir)
659# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
660#endif
661# 232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
662 do l = is3%beg, is3%end
663 do k = is2%beg, is2%end
664 do j = is1%beg, is1%end
665
666# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
667#if defined(MFC_OpenACC)
668# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
669!$acc loop seq
670# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
671#elif defined(MFC_OpenMP)
672# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
673
674# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
675#endif
676 do i = 1, eqn_idx%cont%end
677 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
678 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
679 end do
680
681 vel_l_rms = 0._wp; vel_r_rms = 0._wp
682
683
684# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
685#if defined(MFC_OpenACC)
686# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
687!$acc loop seq
688# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
689#elif defined(MFC_OpenMP)
690# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
691
692# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
693#endif
694 do i = 1, num_vels
695 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
696 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
697 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
698 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
699 end do
700
701
702# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
703#if defined(MFC_OpenACC)
704# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
705!$acc loop seq
706# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
707#elif defined(MFC_OpenMP)
708# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
709
710# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
711#endif
712 do i = 1, num_fluids
713 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
714 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
715 end do
716
717 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
718 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
719
720 if (mhd) then
721 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
722 b%L(1) = bx0
723 b%R(1) = bx0
724 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
725 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg)
726 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
727 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 1)
728 else ! 2D/3D: Bx, By, Bz as variables
729 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
730 b%R(1) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg)
731 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
732 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 1)
733 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
734 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 2)
735 end if
736 end if
737
738 rho_l = 0._wp
739 gamma_l = 0._wp
740 pi_inf_l = 0._wp
741 qv_l = 0._wp
742
743 rho_r = 0._wp
744 gamma_r = 0._wp
745 pi_inf_r = 0._wp
746 qv_r = 0._wp
747
748 alpha_l_sum = 0._wp
749 alpha_r_sum = 0._wp
750
751 pres_mag%L = 0._wp
752 pres_mag%R = 0._wp
753
754 if (mpp_lim) then
755
756# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
757#if defined(MFC_OpenACC)
758# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
759!$acc loop seq
760# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
761#elif defined(MFC_OpenMP)
762# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
763
764# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
765#endif
766 do i = 1, num_fluids
767 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
768 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
769 alpha_l_sum = alpha_l_sum + alpha_l(i)
770 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
771 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
772 alpha_r_sum = alpha_r_sum + alpha_r(i)
773 end do
774
775 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
776 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
777 end if
778
779
780# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
781#if defined(MFC_OpenACC)
782# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
783!$acc loop seq
784# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
785#elif defined(MFC_OpenMP)
786# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
787
788# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
789#endif
790 do i = 1, num_fluids
791 rho_l = rho_l + alpha_rho_l(i)
792 gamma_l = gamma_l + alpha_l(i)*gammas(i)
793 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
794 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
795
796 rho_r = rho_r + alpha_rho_r(i)
797 gamma_r = gamma_r + alpha_r(i)*gammas(i)
798 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
799 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
800 end do
801
802 if (viscous) then
803
804# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
805#if defined(MFC_OpenACC)
806# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
807!$acc loop seq
808# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
809#elif defined(MFC_OpenMP)
810# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
811
812# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
813#endif
814 do i = 1, 2
815 re_l(i) = dflt_real
816 re_r(i) = dflt_real
817
818 if (re_size(i) > 0) re_l(i) = 0._wp
819 if (re_size(i) > 0) re_r(i) = 0._wp
820
821
822# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
823#if defined(MFC_OpenACC)
824# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
825!$acc loop seq
826# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
827#elif defined(MFC_OpenMP)
828# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
829
830# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
831#endif
832 do q = 1, re_size(i)
833 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
834 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
835 end do
836
837 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
838 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
839 end do
840 end if
841
842 if (chemistry) then
843
844# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
845#if defined(MFC_OpenACC)
846# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
847!$acc loop seq
848# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
849#elif defined(MFC_OpenMP)
850# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
851
852# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
853#endif
854 do i = eqn_idx%species%beg, eqn_idx%species%end
855 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
856 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
857 end do
858
859 call get_mixture_molecular_weight(ys_l, mw_l)
860 call get_mixture_molecular_weight(ys_r, mw_r)
861# 355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
862 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
863 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
864# 358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
865
866 r_gas_l = gas_constant/mw_l
867 r_gas_r = gas_constant/mw_r
868 t_l = pres_l/rho_l/r_gas_l
869 t_r = pres_r/rho_r/r_gas_r
870
871 call get_species_specific_heats_r(t_l, cp_il)
872 call get_species_specific_heats_r(t_r, cp_ir)
873
874 if (chem_params%gamma_method == 1) then
875 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
876 gamma_il = cp_il/(cp_il - 1.0_wp)
877 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
878
879 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
880 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
881 else if (chem_params%gamma_method == 2) then
882 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
883 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
884 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
885 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
886 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
887
888 gamm_l = cp_l/cv_l
889 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
890 gamm_r = cp_r/cv_r
891 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
892 end if
893
894 call get_mixture_energy_mass(t_l, ys_l, e_l)
895 call get_mixture_energy_mass(t_r, ys_r, e_r)
896
897 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
898 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
899 h_l = (e_l + pres_l)/rho_l
900 h_r = (e_r + pres_r)/rho_r
901 else if (mhd .and. relativity) then
902 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
903 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
904# 398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
905 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
906 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
907
908 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
909 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
910 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
911 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
912# 406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
913
914 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
915 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
916
917 ! Hard-coded EOS
918 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
919 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
920# 414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
921 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
922 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
923# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
924
925 e_l = rho_l*h_l*ga%L**2 - pres_l + 0.5_wp*(b2%L + vel_l_rms*b2%L - vdotb%L**2._wp) - rho_l*ga%L
926 e_r = rho_r*h_r*ga%R**2 - pres_r + 0.5_wp*(b2%R + vel_r_rms*b2%R - vdotb%R**2._wp) - rho_r*ga%R
927 else if (mhd .and. .not. relativity) then
928# 422 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
929 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
930 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
931# 425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
932 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
933 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r &
934 & + pres_mag%R ! includes magnetic energy
935 h_l = (e_l + pres_l - pres_mag%L)/rho_l
936 h_r = (e_r + pres_r - pres_mag%R) &
937 & /rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
938 else
939 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
940 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
941 h_l = (e_l + pres_l)/rho_l
942 h_r = (e_r + pres_r)/rho_r
943 end if
944
945 ! elastic energy update
946 if (hypoelasticity) then
947 g_l = 0._wp; g_r = 0._wp
948
949
950# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
951#if defined(MFC_OpenACC)
952# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
953!$acc loop seq
954# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
955#elif defined(MFC_OpenMP)
956# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
957
958# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
959#endif
960 do i = 1, num_fluids
961 g_l = g_l + alpha_l(i)*gs_rs(i)
962 g_r = g_r + alpha_r(i)*gs_rs(i)
963 end do
964
965 if (cont_damage) then
966 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
967 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
968 end if
969
970
971# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
972#if defined(MFC_OpenACC)
973# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
974!$acc loop seq
975# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
976#elif defined(MFC_OpenMP)
977# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
978
979# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
980#endif
981 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
982 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
983 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
984 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
985 if ((g_l > 1000) .and. (g_r > 1000)) then
986 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
987 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
988 ! Double for shear stresses
989 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
990 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
991 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
992 end if
993 end if
994 end do
995 end if
996
997 if (avg_state == 1) then
998# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
999 rho_avg = sqrt(rho_l*rho_r)
1000# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1001
1002# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1003 vel_avg_rms = 0._wp
1004# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1005
1006# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1007
1008# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1009#if defined(MFC_OpenACC)
1010# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1011!$acc loop seq
1012# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1013#elif defined(MFC_OpenMP)
1014# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1015
1016# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1017#endif
1018# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1019 do i = 1, num_vels
1020# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1021 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
1022# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1023 end do
1024# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1025
1026# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1027 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
1028# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1029
1030# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1031 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
1032# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1033
1034# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1035 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
1036# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1037
1038# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1039 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
1040# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1041
1042# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1043 if (chemistry) then
1044# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1045 eps = 0.001_wp
1046# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1047 call get_species_enthalpies_rt(t_l, h_il)
1048# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1049 call get_species_enthalpies_rt(t_r, h_ir)
1050# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1051 h_il = h_il*gas_constant/molecular_weights*t_l
1052# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1053 h_ir = h_ir*gas_constant/molecular_weights*t_r
1054# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1055 call get_species_specific_heats_r(t_l, cp_il)
1056# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1057 call get_species_specific_heats_r(t_r, cp_ir)
1058# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1059
1060# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1061 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
1062# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1063 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
1064# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1065 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
1066# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1067 if (abs(t_l - t_r) < eps) then
1068# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1069 ! Case when T_L and T_R are very close
1070# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1071 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
1072# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1073 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
1074# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1075 & - gas_constant/molecular_weights(:)))
1076# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1077 else
1078# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1079 ! Normal calculation when T_L and T_R are sufficiently different
1080# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1081 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
1082# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1083 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
1084# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1085 end if
1086# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1087 gamma_avg = cp_avg/cv_avg
1088# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1089
1090# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1091 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
1092# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1093 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
1094# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1095 end if
1096# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1097 end if
1098# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1099
1100# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1101 if (avg_state == 2) then
1102# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1103 rho_avg = 5.e-1_wp*(rho_l + rho_r)
1104# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1105 vel_avg_rms = 0._wp
1106# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1107
1108# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1109#if defined(MFC_OpenACC)
1110# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1111!$acc loop seq
1112# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1113#elif defined(MFC_OpenMP)
1114# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1115
1116# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1117#endif
1118# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1119 do i = 1, num_vels
1120# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1121 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
1122# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1123 end do
1124# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1125
1126# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1127 h_avg = 5.e-1_wp*(h_l + h_r)
1128# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1129 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
1130# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1131 qv_avg = 5.e-1_wp*(qv_l + qv_r)
1132# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1133 end if
1134
1135 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, c_l, &
1136 & qv_l)
1137
1138 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, c_r, &
1139 & qv_r)
1140
1141 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
1142 ! variables are placeholders to call the subroutine.
1143
1144 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
1145 & c_sum_yi_phi, c_avg, qv_avg)
1146
1147 if (mhd) then
1148 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
1149 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
1150 end if
1151
1152 if (viscous) then
1153 if (chemistry) then
1154 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
1155 end if
1156
1157# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1158#if defined(MFC_OpenACC)
1159# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1160!$acc loop seq
1161# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1162#elif defined(MFC_OpenMP)
1163# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1164
1165# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1166#endif
1167 do i = 1, 2
1168 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
1169 end do
1170 end if
1171
1172 ! Wave speed estimates (wave_speeds=1: direct, wave_speeds=2: pressure-based)
1173 if (wave_speeds == 1) then
1174 if (mhd) then
1175 ! MHD: use fast magnetosonic speed
1176 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
1177 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
1178 else if (hypoelasticity) then
1179 ! Elastic wave speed, Rodriguez et al. JCP (2019)
1180 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
1181 & /rho_l), &
1182 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
1183 & /rho_r))
1184 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
1185 & /rho_r), &
1186 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
1187 & /rho_l))
1188 else if (hyperelasticity) then
1189 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l), &
1190 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
1191 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r), &
1192 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
1193 else
1194 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
1195 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
1196 end if
1197
1198 if (hyper_cleaning) then
1199 ! Dedner GLM divergence cleaning, Dedner et al. JCP (2002)
1200 s_l = min(s_l, -hyper_cleaning_speed)
1201 s_r = max(s_r, hyper_cleaning_speed)
1202 end if
1203
1204 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
1205 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
1206 & - rho_r*(s_r - vel_r(dir_idx(1))))
1207 else if (wave_speeds == 2) then
1208 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1209
1210 pres_sr = pres_sl
1211
1212 ! Low Mach correction: Thornber et al. JCP (2008)
1213 ms_l = max(1._wp, &
1214 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
1215 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
1216 ms_r = max(1._wp, &
1217 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
1218 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
1219
1220 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1221 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1222
1223 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
1224 end if
1225
1226 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1227
1228 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_l)) + (5.e-1_wp - sign(5.e-1_wp, s_l))*(5.e-1_wp + sign(5.e-1_wp, &
1229 & s_r))
1230 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_r)) + (5.e-1_wp - sign(5.e-1_wp, s_l))*(5.e-1_wp + sign(5.e-1_wp, &
1231 & s_r))
1232
1233 ! HLL intercell flux: F* = (s_R*F_L - s_L*F_R + s_L*s_R*(U_R - U_L)) / (s_R - s_L) Low Mach correction
1234 if (low_mach == 1) then
1235 if (riemann_solver == 1 .or. riemann_solver == 5) then
1236# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1237 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1238# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1239 pcorr = 0._wp
1240# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1241
1242# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1243 if (low_mach == 1) then
1244# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1245 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
1246# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1247 end if
1248# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1249 else if (riemann_solver == 2) then
1250# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1251 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1252# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1253 pcorr = 0._wp
1254# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1255
1256# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1257 if (low_mach == 1) then
1258# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1259 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
1260# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1261 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
1262# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1263 else if (low_mach == 2) then
1264# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1265 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1266# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1267 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
1268# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1269 vel_l(dir_idx(1)) = vel_l_tmp
1270# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1271 vel_r(dir_idx(1)) = vel_r_tmp
1272# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1273 end if
1274# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1275 end if
1276 else
1277 pcorr = 0._wp
1278 end if
1279
1280 ! Mass
1281 if (.not. relativity) then
1282
1283# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1284#if defined(MFC_OpenACC)
1285# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1286!$acc loop seq
1287# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1288#elif defined(MFC_OpenMP)
1289# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1290
1291# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1292#endif
1293 do i = 1, eqn_idx%cont%end
1294 flux_rsx_vf(j, k, l, &
1295 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i) &
1296 & *vel_l(norm_dir) + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
1297 end do
1298 else if (relativity) then
1299
1300# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1301#if defined(MFC_OpenACC)
1302# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1303!$acc loop seq
1304# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1305#elif defined(MFC_OpenMP)
1306# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1307
1308# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1309#endif
1310 do i = 1, eqn_idx%cont%end
1311 flux_rsx_vf(j, k, l, &
1312 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
1313 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i))) &
1314 & /(s_m - s_p)
1315 end do
1316 end if
1317
1318 ! Momentum
1319 if (mhd .and. (.not. relativity)) then
1320
1321# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1322#if defined(MFC_OpenACC)
1323# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1324!$acc loop seq
1325# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1326#elif defined(MFC_OpenMP)
1327# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1328
1329# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1330#endif
1331 do i = 1, 3
1332 ! Flux of rho*v_i in the x direction = rho * v_i * v_x - B_i * B_x +
1333 ! delta_(x,i) * p_tot
1334 flux_rsx_vf(j, k, l, &
1335 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
1336 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
1337 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
1338 & ) + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
1339 end do
1340 else if (mhd .and. relativity) then
1341
1342# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1343#if defined(MFC_OpenACC)
1344# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1345!$acc loop seq
1346# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1347#elif defined(MFC_OpenMP)
1348# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1349
1350# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1351#endif
1352 do i = 1, 3
1353 ! Flux of m_i in the x direction = m_i * v_x - b_i/Gamma * B_x +
1354 ! delta_(x,i) * p_tot
1355 flux_rsx_vf(j, k, l, &
1356 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
1357 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
1358 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l &
1359 & + pres_mag%L)) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
1360 end do
1361 else if (bubbles_euler) then
1362
1363# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1364#if defined(MFC_OpenACC)
1365# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1366!$acc loop seq
1367# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1368#elif defined(MFC_OpenMP)
1369# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1370
1371# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1372#endif
1373 do i = 1, num_vels
1374 flux_rsx_vf(j, k, l, &
1375 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
1376 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
1377 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
1378 & *(pres_l - ptilde_l)) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
1379 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
1380 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
1381 end do
1382 else if (hypoelasticity) then
1383
1384# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1385#if defined(MFC_OpenACC)
1386# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1387!$acc loop seq
1388# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1389#elif defined(MFC_OpenMP)
1390# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1391
1392# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1393#endif
1394 do i = 1, num_vels
1395 flux_rsx_vf(j, k, l, &
1396 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
1397 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
1398 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
1399 & *pres_l - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
1400 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
1401 end do
1402 else
1403
1404# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1405#if defined(MFC_OpenACC)
1406# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1407!$acc loop seq
1408# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1409#elif defined(MFC_OpenMP)
1410# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1411
1412# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1413#endif
1414 do i = 1, num_vels
1415 flux_rsx_vf(j, k, l, &
1416 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
1417 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*pres_r) &
1418 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
1419 & *pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i)))) &
1420 & /(s_m - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) &
1421 & - vel_l(dir_idx(i)))
1422 end do
1423 end if
1424
1425 ! Energy
1426 if (mhd .and. (.not. relativity)) then
1427 ! energy flux = (E + p + p_mag) * v_x - B_x * (v_x*B_x + v_y*B_y + v_z*B_z)
1428# 646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1429 flux_rsx_vf(j, k, l, &
1430 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) &
1431 & - b%R(norm_dir)*(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
1432 & - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir) &
1433 & *(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) + s_m*s_p*(e_l &
1434 & - e_r))/(s_m - s_p)
1435# 653 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1436 else if (mhd .and. relativity) then
1437 ! energy flux = m_x - mass flux Hard-coded for single-component for now
1438 flux_rsx_vf(j, k, l, &
1439 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
1440 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l &
1441 & - e_r))/(s_m - s_p)
1442 else if (bubbles_euler) then
1443 flux_rsx_vf(j, k, l, &
1444 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
1445 & - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m &
1446 & - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
1447 else if (hypoelasticity) then
1448 flux_tau_l = 0._wp; flux_tau_r = 0._wp
1449
1450# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1451#if defined(MFC_OpenACC)
1452# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1453!$acc loop seq
1454# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1455#elif defined(MFC_OpenMP)
1456# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1457
1458# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1459#endif
1460 do i = 1, num_dims
1461 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
1462 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
1463 end do
1464 flux_rsx_vf(j, k, l, &
1465 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
1466 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r)) &
1467 & /(s_m - s_p)
1468 else
1469 flux_rsx_vf(j, k, l, &
1470 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1)) &
1471 & *(e_l + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
1472 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
1473 end if
1474
1475 ! Elastic Stresses
1476 if (hypoelasticity) then
1477 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
1478 flux_rsx_vf(j, k, l, &
1479 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
1480 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
1481 & - rho_r*tau_e_r(i)))/(s_m - s_p)
1482 end do
1483 end if
1484
1485 ! Advection flux and source: interface velocity for volume fraction transport
1486
1487# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1488#if defined(MFC_OpenACC)
1489# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1490!$acc loop seq
1491# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1492#elif defined(MFC_OpenMP)
1493# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1494
1495# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1496#endif
1497 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1498 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j + 1, &
1499 & k, l, i))*s_m*s_p/(s_m - s_p)
1500 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j + 1, k, l, &
1501 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
1502 end do
1503
1504 if (bubbles_euler) then
1505 ! From HLLC: Kills mass transport @ bubble gas density
1506 if (num_fluids > 1) then
1507 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
1508 end if
1509 end if
1510
1511 if (chemistry) then
1512
1513# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1514#if defined(MFC_OpenACC)
1515# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1516!$acc loop seq
1517# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1518#elif defined(MFC_OpenMP)
1519# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1520
1521# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1522#endif
1523 do i = eqn_idx%species%beg, eqn_idx%species%end
1524 y_l = ql_prim_rsx_vf(j, k, l, i)
1525 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
1526
1527 flux_rsx_vf(j, k, l, &
1528 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
1529 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
1530 flux_src_rsx_vf(j, k, l, i) = 0._wp
1531 end do
1532 end if
1533
1534 ! MHD: magnetic flux and Maxwell stress contributions
1535 if (mhd) then
1536 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
1537 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
1538
1539# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1540#if defined(MFC_OpenACC)
1541# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1542!$acc loop seq
1543# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1544#elif defined(MFC_OpenMP)
1545# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1546
1547# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1548#endif
1549 do i = 0, 1
1550 flux_rsx_vf(j, k, l, &
1551 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
1552 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
1553 & - b%R(2 + i)))/(s_m - s_p)
1554 end do
1555 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
1556 ! B_x d/dx flux = (1 - delta(x,x)) * (v_x * B_x - v_x * B_x) B_y
1557 ! d/dx flux = (1 - delta(y,x)) * (v_x * B_y - v_y * B_x) B_z d/dx
1558 ! flux = (1 - delta(z,x)) * (v_x * B_z - v_z * B_x)
1559
1560# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1561#if defined(MFC_OpenACC)
1562# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1563!$acc loop seq
1564# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1565#elif defined(MFC_OpenMP)
1566# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1567
1568# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1569#endif
1570 do i = 0, 2
1571 flux_rsx_vf(j, k, l, &
1572 & eqn_idx%B%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1) &
1573 & *b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1) &
1574 & *b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
1575 end do
1576
1577 if (hyper_cleaning) then
1578 ! propagate magnetic field divergence as a wave
1579 flux_rsx_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = flux_rsx_vf(j, k, l, &
1580 & eqn_idx%B%beg + norm_dir - 1) + (s_m*qr_prim_rsx_vf(j + 1, k, &
1581 & l, eqn_idx%psi) - s_p*ql_prim_rsx_vf(j, k, l, &
1582 & eqn_idx%psi))/(s_m - s_p)
1583
1584 flux_rsx_vf(j, k, l, &
1585 & eqn_idx%psi) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) &
1586 & - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsx_vf(j, k, l, &
1587 & eqn_idx%psi) - qr_prim_rsx_vf(j + 1, k, l, &
1588 & eqn_idx%psi)))/(s_m - s_p)
1589 else
1590 flux_rsx_vf(j, k, l, &
1591 & eqn_idx%B%beg + norm_dir - 1) &
1592 & = 0._wp ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
1593 end if
1594 end if
1595 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
1596 end if
1597
1598# 793 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1599 end do
1600 end do
1601 end do
1602
1603# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1604#if defined(MFC_OpenACC)
1605# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1606!$acc end parallel loop
1607# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1608#elif defined(MFC_OpenMP)
1609# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1610
1611# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1612!$omp end target teams loop
1613# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1614#endif
1615 end if
1616# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1617 if (norm_dir == 2) then
1618
1619# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1620
1621# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1622#if defined(MFC_OpenACC)
1623# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1624!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, tau_e_L, tau_e_R, Re_L, Re_R, s_L, s_R, s_S, Ys_L, Ys_R, xi_field_L, xi_field_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, c_fast, pres_mag, B, Ga, vdotB, B2, b4, cm, pcorr, zcoef, vel_L_tmp, vel_R_tmp, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, flux_tau_L, flux_tau_R) copyin(norm_dir)
1625# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1626#elif defined(MFC_OpenMP)
1627# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1628
1629# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1630
1631# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1632
1633# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1634!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, tau_e_L, tau_e_R, Re_L, Re_R, s_L, s_R, s_S, Ys_L, Ys_R, xi_field_L, xi_field_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, c_fast, pres_mag, B, Ga, vdotB, B2, b4, cm, pcorr, zcoef, vel_L_tmp, vel_R_tmp, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, flux_tau_L, flux_tau_R) map(to:norm_dir)
1635# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1636#endif
1637# 232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1638 do l = is3%beg, is3%end
1639 do k = is2%beg, is2%end
1640 do j = is1%beg, is1%end
1641
1642# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1643#if defined(MFC_OpenACC)
1644# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1645!$acc loop seq
1646# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1647#elif defined(MFC_OpenMP)
1648# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1649
1650# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1651#endif
1652 do i = 1, eqn_idx%cont%end
1653 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
1654 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
1655 end do
1656
1657 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1658
1659
1660# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1661#if defined(MFC_OpenACC)
1662# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1663!$acc loop seq
1664# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1665#elif defined(MFC_OpenMP)
1666# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1667
1668# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1669#endif
1670 do i = 1, num_vels
1671 vel_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%cont%end + i)
1672 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%cont%end + i)
1673 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1674 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1675 end do
1676
1677
1678# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1679#if defined(MFC_OpenACC)
1680# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1681!$acc loop seq
1682# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1683#elif defined(MFC_OpenMP)
1684# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1685
1686# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1687#endif
1688 do i = 1, num_fluids
1689 alpha_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)
1690 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)
1691 end do
1692
1693 pres_l = ql_prim_rsy_vf(j, k, l, eqn_idx%E)
1694 pres_r = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E)
1695
1696 if (mhd) then
1697 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
1698 b%L(1) = bx0
1699 b%R(1) = bx0
1700 b%L(2) = ql_prim_rsy_vf(j, k, l, eqn_idx%B%beg)
1701 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%B%beg)
1702 b%L(3) = ql_prim_rsy_vf(j, k, l, eqn_idx%B%beg + 1)
1703 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%B%beg + 1)
1704 else ! 2D/3D: Bx, By, Bz as variables
1705 b%L(1) = ql_prim_rsy_vf(j, k, l, eqn_idx%B%beg)
1706 b%R(1) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%B%beg)
1707 b%L(2) = ql_prim_rsy_vf(j, k, l, eqn_idx%B%beg + 1)
1708 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%B%beg + 1)
1709 b%L(3) = ql_prim_rsy_vf(j, k, l, eqn_idx%B%beg + 2)
1710 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%B%beg + 2)
1711 end if
1712 end if
1713
1714 rho_l = 0._wp
1715 gamma_l = 0._wp
1716 pi_inf_l = 0._wp
1717 qv_l = 0._wp
1718
1719 rho_r = 0._wp
1720 gamma_r = 0._wp
1721 pi_inf_r = 0._wp
1722 qv_r = 0._wp
1723
1724 alpha_l_sum = 0._wp
1725 alpha_r_sum = 0._wp
1726
1727 pres_mag%L = 0._wp
1728 pres_mag%R = 0._wp
1729
1730 if (mpp_lim) then
1731
1732# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1733#if defined(MFC_OpenACC)
1734# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1735!$acc loop seq
1736# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1737#elif defined(MFC_OpenMP)
1738# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1739
1740# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1741#endif
1742 do i = 1, num_fluids
1743 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
1744 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
1745 alpha_l_sum = alpha_l_sum + alpha_l(i)
1746 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
1747 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
1748 alpha_r_sum = alpha_r_sum + alpha_r(i)
1749 end do
1750
1751 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
1752 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
1753 end if
1754
1755
1756# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1757#if defined(MFC_OpenACC)
1758# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1759!$acc loop seq
1760# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1761#elif defined(MFC_OpenMP)
1762# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1763
1764# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1765#endif
1766 do i = 1, num_fluids
1767 rho_l = rho_l + alpha_rho_l(i)
1768 gamma_l = gamma_l + alpha_l(i)*gammas(i)
1769 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
1770 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
1771
1772 rho_r = rho_r + alpha_rho_r(i)
1773 gamma_r = gamma_r + alpha_r(i)*gammas(i)
1774 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
1775 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
1776 end do
1777
1778 if (viscous) then
1779
1780# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1781#if defined(MFC_OpenACC)
1782# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1783!$acc loop seq
1784# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1785#elif defined(MFC_OpenMP)
1786# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1787
1788# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1789#endif
1790 do i = 1, 2
1791 re_l(i) = dflt_real
1792 re_r(i) = dflt_real
1793
1794 if (re_size(i) > 0) re_l(i) = 0._wp
1795 if (re_size(i) > 0) re_r(i) = 0._wp
1796
1797
1798# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1799#if defined(MFC_OpenACC)
1800# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1801!$acc loop seq
1802# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1803#elif defined(MFC_OpenMP)
1804# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1805
1806# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1807#endif
1808 do q = 1, re_size(i)
1809 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
1810 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
1811 end do
1812
1813 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
1814 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
1815 end do
1816 end if
1817
1818 if (chemistry) then
1819
1820# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1821#if defined(MFC_OpenACC)
1822# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1823!$acc loop seq
1824# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1825#elif defined(MFC_OpenMP)
1826# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1827
1828# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1829#endif
1830 do i = eqn_idx%species%beg, eqn_idx%species%end
1831 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsy_vf(j, k, l, i)
1832 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsy_vf(j + 1, k, l, i)
1833 end do
1834
1835 call get_mixture_molecular_weight(ys_l, mw_l)
1836 call get_mixture_molecular_weight(ys_r, mw_r)
1837# 355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1838 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
1839 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
1840# 358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1841
1842 r_gas_l = gas_constant/mw_l
1843 r_gas_r = gas_constant/mw_r
1844 t_l = pres_l/rho_l/r_gas_l
1845 t_r = pres_r/rho_r/r_gas_r
1846
1847 call get_species_specific_heats_r(t_l, cp_il)
1848 call get_species_specific_heats_r(t_r, cp_ir)
1849
1850 if (chem_params%gamma_method == 1) then
1851 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
1852 gamma_il = cp_il/(cp_il - 1.0_wp)
1853 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
1854
1855 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
1856 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
1857 else if (chem_params%gamma_method == 2) then
1858 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
1859 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
1860 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
1861 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
1862 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
1863
1864 gamm_l = cp_l/cv_l
1865 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
1866 gamm_r = cp_r/cv_r
1867 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
1868 end if
1869
1870 call get_mixture_energy_mass(t_l, ys_l, e_l)
1871 call get_mixture_energy_mass(t_r, ys_r, e_r)
1872
1873 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
1874 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
1875 h_l = (e_l + pres_l)/rho_l
1876 h_r = (e_r + pres_r)/rho_r
1877 else if (mhd .and. relativity) then
1878 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
1879 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
1880# 398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1881 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
1882 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
1883
1884 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
1885 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
1886 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
1887 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
1888# 406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1889
1890 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
1891 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
1892
1893 ! Hard-coded EOS
1894 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
1895 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
1896# 414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1897 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
1898 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
1899# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1900
1901 e_l = rho_l*h_l*ga%L**2 - pres_l + 0.5_wp*(b2%L + vel_l_rms*b2%L - vdotb%L**2._wp) - rho_l*ga%L
1902 e_r = rho_r*h_r*ga%R**2 - pres_r + 0.5_wp*(b2%R + vel_r_rms*b2%R - vdotb%R**2._wp) - rho_r*ga%R
1903 else if (mhd .and. .not. relativity) then
1904# 422 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1905 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
1906 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
1907# 425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1908 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
1909 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r &
1910 & + pres_mag%R ! includes magnetic energy
1911 h_l = (e_l + pres_l - pres_mag%L)/rho_l
1912 h_r = (e_r + pres_r - pres_mag%R) &
1913 & /rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
1914 else
1915 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
1916 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
1917 h_l = (e_l + pres_l)/rho_l
1918 h_r = (e_r + pres_r)/rho_r
1919 end if
1920
1921 ! elastic energy update
1922 if (hypoelasticity) then
1923 g_l = 0._wp; g_r = 0._wp
1924
1925
1926# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1927#if defined(MFC_OpenACC)
1928# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1929!$acc loop seq
1930# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1931#elif defined(MFC_OpenMP)
1932# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1933
1934# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1935#endif
1936 do i = 1, num_fluids
1937 g_l = g_l + alpha_l(i)*gs_rs(i)
1938 g_r = g_r + alpha_r(i)*gs_rs(i)
1939 end do
1940
1941 if (cont_damage) then
1942 g_l = g_l*max((1._wp - ql_prim_rsy_vf(j, k, l, eqn_idx%damage)), 0._wp)
1943 g_r = g_r*max((1._wp - qr_prim_rsy_vf(j, k, l, eqn_idx%damage)), 0._wp)
1944 end if
1945
1946
1947# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1948#if defined(MFC_OpenACC)
1949# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1950!$acc loop seq
1951# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1952#elif defined(MFC_OpenMP)
1953# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1954
1955# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1956#endif
1957 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
1958 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
1959 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
1960 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
1961 if ((g_l > 1000) .and. (g_r > 1000)) then
1962 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
1963 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
1964 ! Double for shear stresses
1965 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
1966 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
1967 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
1968 end if
1969 end if
1970 end do
1971 end if
1972
1973 if (avg_state == 1) then
1974# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1975 rho_avg = sqrt(rho_l*rho_r)
1976# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1977
1978# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1979 vel_avg_rms = 0._wp
1980# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1981
1982# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1983
1984# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1985#if defined(MFC_OpenACC)
1986# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1987!$acc loop seq
1988# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1989#elif defined(MFC_OpenMP)
1990# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1991
1992# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1993#endif
1994# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1995 do i = 1, num_vels
1996# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1997 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
1998# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1999 end do
2000# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2001
2002# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2003 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
2004# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2005
2006# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2007 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
2008# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2009
2010# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2011 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
2012# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2013
2014# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2015 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
2016# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2017
2018# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2019 if (chemistry) then
2020# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2021 eps = 0.001_wp
2022# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2023 call get_species_enthalpies_rt(t_l, h_il)
2024# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2025 call get_species_enthalpies_rt(t_r, h_ir)
2026# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2027 h_il = h_il*gas_constant/molecular_weights*t_l
2028# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2029 h_ir = h_ir*gas_constant/molecular_weights*t_r
2030# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2031 call get_species_specific_heats_r(t_l, cp_il)
2032# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2033 call get_species_specific_heats_r(t_r, cp_ir)
2034# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2035
2036# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2037 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
2038# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2039 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
2040# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2041 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
2042# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2043 if (abs(t_l - t_r) < eps) then
2044# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2045 ! Case when T_L and T_R are very close
2046# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2047 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
2048# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2049 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
2050# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2051 & - gas_constant/molecular_weights(:)))
2052# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2053 else
2054# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2055 ! Normal calculation when T_L and T_R are sufficiently different
2056# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2057 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
2058# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2059 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
2060# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2061 end if
2062# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2063 gamma_avg = cp_avg/cv_avg
2064# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2065
2066# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2067 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
2068# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2069 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
2070# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2071 end if
2072# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2073 end if
2074# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2075
2076# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2077 if (avg_state == 2) then
2078# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2079 rho_avg = 5.e-1_wp*(rho_l + rho_r)
2080# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2081 vel_avg_rms = 0._wp
2082# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2083
2084# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2085#if defined(MFC_OpenACC)
2086# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2087!$acc loop seq
2088# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2089#elif defined(MFC_OpenMP)
2090# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2091
2092# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2093#endif
2094# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2095 do i = 1, num_vels
2096# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2097 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
2098# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2099 end do
2100# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2101
2102# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2103 h_avg = 5.e-1_wp*(h_l + h_r)
2104# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2105 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
2106# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2107 qv_avg = 5.e-1_wp*(qv_l + qv_r)
2108# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2109 end if
2110
2111 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, c_l, &
2112 & qv_l)
2113
2114 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, c_r, &
2115 & qv_r)
2116
2117 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
2118 ! variables are placeholders to call the subroutine.
2119
2120 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
2121 & c_sum_yi_phi, c_avg, qv_avg)
2122
2123 if (mhd) then
2124 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
2125 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
2126 end if
2127
2128 if (viscous) then
2129 if (chemistry) then
2130 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
2131 end if
2132
2133# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2134#if defined(MFC_OpenACC)
2135# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2136!$acc loop seq
2137# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2138#elif defined(MFC_OpenMP)
2139# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2140
2141# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2142#endif
2143 do i = 1, 2
2144 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2145 end do
2146 end if
2147
2148 ! Wave speed estimates (wave_speeds=1: direct, wave_speeds=2: pressure-based)
2149 if (wave_speeds == 1) then
2150 if (mhd) then
2151 ! MHD: use fast magnetosonic speed
2152 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
2153 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
2154 else if (hypoelasticity) then
2155 ! Elastic wave speed, Rodriguez et al. JCP (2019)
2156 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
2157 & /rho_l), &
2158 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
2159 & /rho_r))
2160 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
2161 & /rho_r), &
2162 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
2163 & /rho_l))
2164 else if (hyperelasticity) then
2165 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l), &
2166 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
2167 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r), &
2168 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
2169 else
2170 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
2171 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
2172 end if
2173
2174 if (hyper_cleaning) then
2175 ! Dedner GLM divergence cleaning, Dedner et al. JCP (2002)
2176 s_l = min(s_l, -hyper_cleaning_speed)
2177 s_r = max(s_r, hyper_cleaning_speed)
2178 end if
2179
2180 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
2181 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
2182 & - rho_r*(s_r - vel_r(dir_idx(1))))
2183 else if (wave_speeds == 2) then
2184 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2185
2186 pres_sr = pres_sl
2187
2188 ! Low Mach correction: Thornber et al. JCP (2008)
2189 ms_l = max(1._wp, &
2190 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
2191 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
2192 ms_r = max(1._wp, &
2193 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
2194 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
2195
2196 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2197 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2198
2199 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
2200 end if
2201
2202 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2203
2204 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_l)) + (5.e-1_wp - sign(5.e-1_wp, s_l))*(5.e-1_wp + sign(5.e-1_wp, &
2205 & s_r))
2206 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_r)) + (5.e-1_wp - sign(5.e-1_wp, s_l))*(5.e-1_wp + sign(5.e-1_wp, &
2207 & s_r))
2208
2209 ! HLL intercell flux: F* = (s_R*F_L - s_L*F_R + s_L*s_R*(U_R - U_L)) / (s_R - s_L) Low Mach correction
2210 if (low_mach == 1) then
2211 if (riemann_solver == 1 .or. riemann_solver == 5) then
2212# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2213 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2214# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2215 pcorr = 0._wp
2216# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2217
2218# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2219 if (low_mach == 1) then
2220# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2221 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2222# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2223 end if
2224# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2225 else if (riemann_solver == 2) then
2226# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2227 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2228# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2229 pcorr = 0._wp
2230# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2231
2232# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2233 if (low_mach == 1) then
2234# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2235 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
2236# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2237 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2238# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2239 else if (low_mach == 2) then
2240# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2241 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2242# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2243 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
2244# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2245 vel_l(dir_idx(1)) = vel_l_tmp
2246# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2247 vel_r(dir_idx(1)) = vel_r_tmp
2248# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2249 end if
2250# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2251 end if
2252 else
2253 pcorr = 0._wp
2254 end if
2255
2256 ! Mass
2257 if (.not. relativity) then
2258
2259# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2260#if defined(MFC_OpenACC)
2261# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2262!$acc loop seq
2263# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2264#elif defined(MFC_OpenMP)
2265# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2266
2267# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2268#endif
2269 do i = 1, eqn_idx%cont%end
2270 flux_rsy_vf(j, k, l, &
2271 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i) &
2272 & *vel_l(norm_dir) + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
2273 end do
2274 else if (relativity) then
2275
2276# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2277#if defined(MFC_OpenACC)
2278# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2279!$acc loop seq
2280# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2281#elif defined(MFC_OpenMP)
2282# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2283
2284# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2285#endif
2286 do i = 1, eqn_idx%cont%end
2287 flux_rsy_vf(j, k, l, &
2288 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
2289 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i))) &
2290 & /(s_m - s_p)
2291 end do
2292 end if
2293
2294 ! Momentum
2295 if (mhd .and. (.not. relativity)) then
2296
2297# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2298#if defined(MFC_OpenACC)
2299# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2300!$acc loop seq
2301# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2302#elif defined(MFC_OpenMP)
2303# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2304
2305# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2306#endif
2307 do i = 1, 3
2308 ! Flux of rho*v_i in the y direction = rho * v_i * v_y - B_i * B_y +
2309 ! delta_(y,i) * p_tot
2310 flux_rsy_vf(j, k, l, &
2311 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
2312 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
2313 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
2314 & ) + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
2315 end do
2316 else if (mhd .and. relativity) then
2317
2318# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2319#if defined(MFC_OpenACC)
2320# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2321!$acc loop seq
2322# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2323#elif defined(MFC_OpenMP)
2324# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2325
2326# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2327#endif
2328 do i = 1, 3
2329 ! Flux of m_i in the y direction = m_i * v_y - b_i/Gamma * B_y +
2330 ! delta_(y,i) * p_tot
2331 flux_rsy_vf(j, k, l, &
2332 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
2333 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
2334 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l &
2335 & + pres_mag%L)) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
2336 end do
2337 else if (bubbles_euler) then
2338
2339# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2340#if defined(MFC_OpenACC)
2341# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2342!$acc loop seq
2343# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2344#elif defined(MFC_OpenMP)
2345# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2346
2347# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2348#endif
2349 do i = 1, num_vels
2350 flux_rsy_vf(j, k, l, &
2351 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
2352 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
2353 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
2354 & *(pres_l - ptilde_l)) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
2355 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
2356 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
2357 end do
2358 else if (hypoelasticity) then
2359
2360# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2361#if defined(MFC_OpenACC)
2362# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2363!$acc loop seq
2364# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2365#elif defined(MFC_OpenMP)
2366# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2367
2368# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2369#endif
2370 do i = 1, num_vels
2371 flux_rsy_vf(j, k, l, &
2372 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
2373 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
2374 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
2375 & *pres_l - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
2376 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
2377 end do
2378 else
2379
2380# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2381#if defined(MFC_OpenACC)
2382# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2383!$acc loop seq
2384# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2385#elif defined(MFC_OpenMP)
2386# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2387
2388# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2389#endif
2390 do i = 1, num_vels
2391 flux_rsy_vf(j, k, l, &
2392 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
2393 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*pres_r) &
2394 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
2395 & *pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i)))) &
2396 & /(s_m - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) &
2397 & - vel_l(dir_idx(i)))
2398 end do
2399 end if
2400
2401 ! Energy
2402 if (mhd .and. (.not. relativity)) then
2403 ! energy flux = (E + p + p_mag) * v_y - B_y * (v_x*B_x + v_y*B_y + v_z*B_z)
2404# 646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2405 flux_rsy_vf(j, k, l, &
2406 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) &
2407 & - b%R(norm_dir)*(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
2408 & - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir) &
2409 & *(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) + s_m*s_p*(e_l &
2410 & - e_r))/(s_m - s_p)
2411# 653 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2412 else if (mhd .and. relativity) then
2413 ! energy flux = m_y - mass flux Hard-coded for single-component for now
2414 flux_rsy_vf(j, k, l, &
2415 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
2416 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l &
2417 & - e_r))/(s_m - s_p)
2418 else if (bubbles_euler) then
2419 flux_rsy_vf(j, k, l, &
2420 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
2421 & - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m &
2422 & - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
2423 else if (hypoelasticity) then
2424 flux_tau_l = 0._wp; flux_tau_r = 0._wp
2425
2426# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2427#if defined(MFC_OpenACC)
2428# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2429!$acc loop seq
2430# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2431#elif defined(MFC_OpenMP)
2432# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2433
2434# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2435#endif
2436 do i = 1, num_dims
2437 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
2438 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
2439 end do
2440 flux_rsy_vf(j, k, l, &
2441 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
2442 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r)) &
2443 & /(s_m - s_p)
2444 else
2445 flux_rsy_vf(j, k, l, &
2446 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1)) &
2447 & *(e_l + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
2448 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
2449 end if
2450
2451 ! Elastic Stresses
2452 if (hypoelasticity) then
2453 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
2454 flux_rsy_vf(j, k, l, &
2455 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
2456 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
2457 & - rho_r*tau_e_r(i)))/(s_m - s_p)
2458 end do
2459 end if
2460
2461 ! Advection flux and source: interface velocity for volume fraction transport
2462
2463# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2464#if defined(MFC_OpenACC)
2465# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2466!$acc loop seq
2467# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2468#elif defined(MFC_OpenMP)
2469# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2470
2471# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2472#endif
2473 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2474 flux_rsy_vf(j, k, l, i) = (ql_prim_rsy_vf(j, k, l, i) - qr_prim_rsy_vf(j + 1, &
2475 & k, l, i))*s_m*s_p/(s_m - s_p)
2476 flux_src_rsy_vf(j, k, l, i) = (s_m*qr_prim_rsy_vf(j + 1, k, l, &
2477 & i) - s_p*ql_prim_rsy_vf(j, k, l, i))/(s_m - s_p)
2478 end do
2479
2480 if (bubbles_euler) then
2481 ! From HLLC: Kills mass transport @ bubble gas density
2482 if (num_fluids > 1) then
2483 flux_rsy_vf(j, k, l, eqn_idx%cont%end) = 0._wp
2484 end if
2485 end if
2486
2487 if (chemistry) then
2488
2489# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2490#if defined(MFC_OpenACC)
2491# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2492!$acc loop seq
2493# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2494#elif defined(MFC_OpenMP)
2495# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2496
2497# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2498#endif
2499 do i = eqn_idx%species%beg, eqn_idx%species%end
2500 y_l = ql_prim_rsy_vf(j, k, l, i)
2501 y_r = qr_prim_rsy_vf(j + 1, k, l, i)
2502
2503 flux_rsy_vf(j, k, l, &
2504 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
2505 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
2506 flux_src_rsy_vf(j, k, l, i) = 0._wp
2507 end do
2508 end if
2509
2510 ! MHD: magnetic flux and Maxwell stress contributions
2511 if (mhd) then
2512 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
2513 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
2514
2515# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2516#if defined(MFC_OpenACC)
2517# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2518!$acc loop seq
2519# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2520#elif defined(MFC_OpenMP)
2521# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2522
2523# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2524#endif
2525 do i = 0, 1
2526 flux_rsx_vf(j, k, l, &
2527 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
2528 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
2529 & - b%R(2 + i)))/(s_m - s_p)
2530 end do
2531 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
2532 ! B_x d/dy flux = (1 - delta(x,y)) * (v_y * B_x - v_x * B_y) B_y
2533 ! d/dy flux = (1 - delta(y,y)) * (v_y * B_y - v_y * B_y) B_z d/dy
2534 ! flux = (1 - delta(z,y)) * (v_y * B_z - v_z * B_y)
2535
2536# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2537#if defined(MFC_OpenACC)
2538# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2539!$acc loop seq
2540# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2541#elif defined(MFC_OpenMP)
2542# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2543
2544# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2545#endif
2546 do i = 0, 2
2547 flux_rsy_vf(j, k, l, &
2548 & eqn_idx%B%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1) &
2549 & *b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1) &
2550 & *b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
2551 end do
2552
2553 if (hyper_cleaning) then
2554 ! propagate magnetic field divergence as a wave
2555 flux_rsy_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = flux_rsy_vf(j, k, l, &
2556 & eqn_idx%B%beg + norm_dir - 1) + (s_m*qr_prim_rsy_vf(j + 1, k, &
2557 & l, eqn_idx%psi) - s_p*ql_prim_rsy_vf(j, k, l, &
2558 & eqn_idx%psi))/(s_m - s_p)
2559
2560 flux_rsy_vf(j, k, l, &
2561 & eqn_idx%psi) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) &
2562 & - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsy_vf(j, k, l, &
2563 & eqn_idx%psi) - qr_prim_rsy_vf(j + 1, k, l, &
2564 & eqn_idx%psi)))/(s_m - s_p)
2565 else
2566 flux_rsy_vf(j, k, l, &
2567 & eqn_idx%B%beg + norm_dir - 1) &
2568 & = 0._wp ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
2569 end if
2570 end if
2571 flux_src_rsy_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
2572 end if
2573
2574# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2575 if (cyl_coord) then
2576 ! Substituting the advective flux into the inviscid geometrical source flux
2577
2578# 768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2579#if defined(MFC_OpenACC)
2580# 768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2581!$acc loop seq
2582# 768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2583#elif defined(MFC_OpenMP)
2584# 768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2585
2586# 768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2587#endif
2588 do i = 1, eqn_idx%E
2589 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
2590 end do
2591 ! Recalculating the radial momentum geometric source flux
2592 flux_gsrc_rsy_vf(j, k, l, eqn_idx%cont%end + 2) = flux_rsy_vf(j, k, l, &
2593 & eqn_idx%cont%end + 2) - (s_m*pres_r - s_p*pres_l)/(s_m - s_p)
2594 ! Geometrical source of the void fraction(s) is zero
2595
2596# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2597#if defined(MFC_OpenACC)
2598# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2599!$acc loop seq
2600# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2601#elif defined(MFC_OpenMP)
2602# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2603
2604# 776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2605#endif
2606 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2607 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
2608 end do
2609 end if
2610
2611 if (cyl_coord .and. hypoelasticity) then
2612 ! += tau_sigmasigma using HLL
2613 flux_gsrc_rsy_vf(j, k, l, eqn_idx%cont%end + 2) = flux_gsrc_rsy_vf(j, k, l, &
2614 & eqn_idx%cont%end + 2) + (s_m*tau_e_r(4) - s_p*tau_e_l(4))/(s_m - s_p)
2615
2616
2617# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2618#if defined(MFC_OpenACC)
2619# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2620!$acc loop seq
2621# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2622#elif defined(MFC_OpenMP)
2623# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2624
2625# 787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2626#endif
2627 do i = eqn_idx%stress%beg, eqn_idx%stress%end
2628 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
2629 end do
2630 end if
2631# 793 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2632 end do
2633 end do
2634 end do
2635
2636# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2637#if defined(MFC_OpenACC)
2638# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2639!$acc end parallel loop
2640# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2641#elif defined(MFC_OpenMP)
2642# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2643
2644# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2645!$omp end target teams loop
2646# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2647#endif
2648 end if
2649# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2650 if (norm_dir == 3) then
2651
2652# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2653
2654# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2655#if defined(MFC_OpenACC)
2656# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2657!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, tau_e_L, tau_e_R, Re_L, Re_R, s_L, s_R, s_S, Ys_L, Ys_R, xi_field_L, xi_field_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, c_fast, pres_mag, B, Ga, vdotB, B2, b4, cm, pcorr, zcoef, vel_L_tmp, vel_R_tmp, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, flux_tau_L, flux_tau_R) copyin(norm_dir)
2658# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2659#elif defined(MFC_OpenMP)
2660# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2661
2662# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2663
2664# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2665
2666# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2667!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, tau_e_L, tau_e_R, Re_L, Re_R, s_L, s_R, s_S, Ys_L, Ys_R, xi_field_L, xi_field_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, c_fast, pres_mag, B, Ga, vdotB, B2, b4, cm, pcorr, zcoef, vel_L_tmp, vel_R_tmp, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, flux_tau_L, flux_tau_R) map(to:norm_dir)
2668# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2669#endif
2670# 232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2671 do l = is3%beg, is3%end
2672 do k = is2%beg, is2%end
2673 do j = is1%beg, is1%end
2674
2675# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2676#if defined(MFC_OpenACC)
2677# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2678!$acc loop seq
2679# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2680#elif defined(MFC_OpenMP)
2681# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2682
2683# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2684#endif
2685 do i = 1, eqn_idx%cont%end
2686 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
2687 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
2688 end do
2689
2690 vel_l_rms = 0._wp; vel_r_rms = 0._wp
2691
2692
2693# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2694#if defined(MFC_OpenACC)
2695# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2696!$acc loop seq
2697# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2698#elif defined(MFC_OpenMP)
2699# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2700
2701# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2702#endif
2703 do i = 1, num_vels
2704 vel_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%cont%end + i)
2705 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%cont%end + i)
2706 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
2707 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
2708 end do
2709
2710
2711# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2712#if defined(MFC_OpenACC)
2713# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2714!$acc loop seq
2715# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2716#elif defined(MFC_OpenMP)
2717# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2718
2719# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2720#endif
2721 do i = 1, num_fluids
2722 alpha_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)
2723 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)
2724 end do
2725
2726 pres_l = ql_prim_rsz_vf(j, k, l, eqn_idx%E)
2727 pres_r = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E)
2728
2729 if (mhd) then
2730 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
2731 b%L(1) = bx0
2732 b%R(1) = bx0
2733 b%L(2) = ql_prim_rsz_vf(j, k, l, eqn_idx%B%beg)
2734 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%B%beg)
2735 b%L(3) = ql_prim_rsz_vf(j, k, l, eqn_idx%B%beg + 1)
2736 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%B%beg + 1)
2737 else ! 2D/3D: Bx, By, Bz as variables
2738 b%L(1) = ql_prim_rsz_vf(j, k, l, eqn_idx%B%beg)
2739 b%R(1) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%B%beg)
2740 b%L(2) = ql_prim_rsz_vf(j, k, l, eqn_idx%B%beg + 1)
2741 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%B%beg + 1)
2742 b%L(3) = ql_prim_rsz_vf(j, k, l, eqn_idx%B%beg + 2)
2743 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%B%beg + 2)
2744 end if
2745 end if
2746
2747 rho_l = 0._wp
2748 gamma_l = 0._wp
2749 pi_inf_l = 0._wp
2750 qv_l = 0._wp
2751
2752 rho_r = 0._wp
2753 gamma_r = 0._wp
2754 pi_inf_r = 0._wp
2755 qv_r = 0._wp
2756
2757 alpha_l_sum = 0._wp
2758 alpha_r_sum = 0._wp
2759
2760 pres_mag%L = 0._wp
2761 pres_mag%R = 0._wp
2762
2763 if (mpp_lim) then
2764
2765# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2766#if defined(MFC_OpenACC)
2767# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2768!$acc loop seq
2769# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2770#elif defined(MFC_OpenMP)
2771# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2772
2773# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2774#endif
2775 do i = 1, num_fluids
2776 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
2777 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
2778 alpha_l_sum = alpha_l_sum + alpha_l(i)
2779 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
2780 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
2781 alpha_r_sum = alpha_r_sum + alpha_r(i)
2782 end do
2783
2784 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
2785 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
2786 end if
2787
2788
2789# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2790#if defined(MFC_OpenACC)
2791# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2792!$acc loop seq
2793# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2794#elif defined(MFC_OpenMP)
2795# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2796
2797# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2798#endif
2799 do i = 1, num_fluids
2800 rho_l = rho_l + alpha_rho_l(i)
2801 gamma_l = gamma_l + alpha_l(i)*gammas(i)
2802 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
2803 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
2804
2805 rho_r = rho_r + alpha_rho_r(i)
2806 gamma_r = gamma_r + alpha_r(i)*gammas(i)
2807 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
2808 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
2809 end do
2810
2811 if (viscous) then
2812
2813# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2814#if defined(MFC_OpenACC)
2815# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2816!$acc loop seq
2817# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2818#elif defined(MFC_OpenMP)
2819# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2820
2821# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2822#endif
2823 do i = 1, 2
2824 re_l(i) = dflt_real
2825 re_r(i) = dflt_real
2826
2827 if (re_size(i) > 0) re_l(i) = 0._wp
2828 if (re_size(i) > 0) re_r(i) = 0._wp
2829
2830
2831# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2832#if defined(MFC_OpenACC)
2833# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2834!$acc loop seq
2835# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2836#elif defined(MFC_OpenMP)
2837# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2838
2839# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2840#endif
2841 do q = 1, re_size(i)
2842 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
2843 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
2844 end do
2845
2846 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
2847 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
2848 end do
2849 end if
2850
2851 if (chemistry) then
2852
2853# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2854#if defined(MFC_OpenACC)
2855# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2856!$acc loop seq
2857# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2858#elif defined(MFC_OpenMP)
2859# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2860
2861# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2862#endif
2863 do i = eqn_idx%species%beg, eqn_idx%species%end
2864 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsz_vf(j, k, l, i)
2865 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsz_vf(j + 1, k, l, i)
2866 end do
2867
2868 call get_mixture_molecular_weight(ys_l, mw_l)
2869 call get_mixture_molecular_weight(ys_r, mw_r)
2870# 355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2871 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
2872 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
2873# 358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2874
2875 r_gas_l = gas_constant/mw_l
2876 r_gas_r = gas_constant/mw_r
2877 t_l = pres_l/rho_l/r_gas_l
2878 t_r = pres_r/rho_r/r_gas_r
2879
2880 call get_species_specific_heats_r(t_l, cp_il)
2881 call get_species_specific_heats_r(t_r, cp_ir)
2882
2883 if (chem_params%gamma_method == 1) then
2884 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
2885 gamma_il = cp_il/(cp_il - 1.0_wp)
2886 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
2887
2888 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
2889 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
2890 else if (chem_params%gamma_method == 2) then
2891 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
2892 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
2893 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
2894 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
2895 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
2896
2897 gamm_l = cp_l/cv_l
2898 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
2899 gamm_r = cp_r/cv_r
2900 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
2901 end if
2902
2903 call get_mixture_energy_mass(t_l, ys_l, e_l)
2904 call get_mixture_energy_mass(t_r, ys_r, e_r)
2905
2906 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
2907 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
2908 h_l = (e_l + pres_l)/rho_l
2909 h_r = (e_r + pres_r)/rho_r
2910 else if (mhd .and. relativity) then
2911 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
2912 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
2913# 398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2914 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
2915 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
2916
2917 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
2918 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
2919 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
2920 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
2921# 406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2922
2923 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
2924 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
2925
2926 ! Hard-coded EOS
2927 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
2928 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
2929# 414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2930 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
2931 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
2932# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2933
2934 e_l = rho_l*h_l*ga%L**2 - pres_l + 0.5_wp*(b2%L + vel_l_rms*b2%L - vdotb%L**2._wp) - rho_l*ga%L
2935 e_r = rho_r*h_r*ga%R**2 - pres_r + 0.5_wp*(b2%R + vel_r_rms*b2%R - vdotb%R**2._wp) - rho_r*ga%R
2936 else if (mhd .and. .not. relativity) then
2937# 422 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2938 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
2939 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
2940# 425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2941 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
2942 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r &
2943 & + pres_mag%R ! includes magnetic energy
2944 h_l = (e_l + pres_l - pres_mag%L)/rho_l
2945 h_r = (e_r + pres_r - pres_mag%R) &
2946 & /rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
2947 else
2948 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
2949 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
2950 h_l = (e_l + pres_l)/rho_l
2951 h_r = (e_r + pres_r)/rho_r
2952 end if
2953
2954 ! elastic energy update
2955 if (hypoelasticity) then
2956 g_l = 0._wp; g_r = 0._wp
2957
2958
2959# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2960#if defined(MFC_OpenACC)
2961# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2962!$acc loop seq
2963# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2964#elif defined(MFC_OpenMP)
2965# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2966
2967# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2968#endif
2969 do i = 1, num_fluids
2970 g_l = g_l + alpha_l(i)*gs_rs(i)
2971 g_r = g_r + alpha_r(i)*gs_rs(i)
2972 end do
2973
2974 if (cont_damage) then
2975 g_l = g_l*max((1._wp - ql_prim_rsz_vf(j, k, l, eqn_idx%damage)), 0._wp)
2976 g_r = g_r*max((1._wp - qr_prim_rsz_vf(j, k, l, eqn_idx%damage)), 0._wp)
2977 end if
2978
2979
2980# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2981#if defined(MFC_OpenACC)
2982# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2983!$acc loop seq
2984# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2985#elif defined(MFC_OpenMP)
2986# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2987
2988# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2989#endif
2990 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
2991 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
2992 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
2993 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
2994 if ((g_l > 1000) .and. (g_r > 1000)) then
2995 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2996 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2997 ! Double for shear stresses
2998 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
2999 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
3000 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
3001 end if
3002 end if
3003 end do
3004 end if
3005
3006 if (avg_state == 1) then
3007# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3008 rho_avg = sqrt(rho_l*rho_r)
3009# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3010
3011# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3012 vel_avg_rms = 0._wp
3013# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3014
3015# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3016
3017# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3018#if defined(MFC_OpenACC)
3019# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3020!$acc loop seq
3021# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3022#elif defined(MFC_OpenMP)
3023# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3024
3025# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3026#endif
3027# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3028 do i = 1, num_vels
3029# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3030 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
3031# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3032 end do
3033# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3034
3035# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3036 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
3037# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3038
3039# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3040 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
3041# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3042
3043# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3044 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
3045# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3046
3047# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3048 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
3049# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3050
3051# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3052 if (chemistry) then
3053# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3054 eps = 0.001_wp
3055# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3056 call get_species_enthalpies_rt(t_l, h_il)
3057# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3058 call get_species_enthalpies_rt(t_r, h_ir)
3059# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3060 h_il = h_il*gas_constant/molecular_weights*t_l
3061# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3062 h_ir = h_ir*gas_constant/molecular_weights*t_r
3063# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3064 call get_species_specific_heats_r(t_l, cp_il)
3065# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3066 call get_species_specific_heats_r(t_r, cp_ir)
3067# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3068
3069# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3070 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
3071# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3072 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
3073# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3074 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
3075# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3076 if (abs(t_l - t_r) < eps) then
3077# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3078 ! Case when T_L and T_R are very close
3079# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3080 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
3081# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3082 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
3083# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3084 & - gas_constant/molecular_weights(:)))
3085# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3086 else
3087# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3088 ! Normal calculation when T_L and T_R are sufficiently different
3089# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3090 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
3091# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3092 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
3093# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3094 end if
3095# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3096 gamma_avg = cp_avg/cv_avg
3097# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3098
3099# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3100 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
3101# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3102 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
3103# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3104 end if
3105# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3106 end if
3107# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3108
3109# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3110 if (avg_state == 2) then
3111# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3112 rho_avg = 5.e-1_wp*(rho_l + rho_r)
3113# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3114 vel_avg_rms = 0._wp
3115# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3116
3117# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3118#if defined(MFC_OpenACC)
3119# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3120!$acc loop seq
3121# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3122#elif defined(MFC_OpenMP)
3123# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3124
3125# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3126#endif
3127# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3128 do i = 1, num_vels
3129# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3130 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
3131# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3132 end do
3133# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3134
3135# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3136 h_avg = 5.e-1_wp*(h_l + h_r)
3137# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3138 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
3139# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3140 qv_avg = 5.e-1_wp*(qv_l + qv_r)
3141# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3142 end if
3143
3144 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, c_l, &
3145 & qv_l)
3146
3147 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, c_r, &
3148 & qv_r)
3149
3150 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
3151 ! variables are placeholders to call the subroutine.
3152
3153 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
3154 & c_sum_yi_phi, c_avg, qv_avg)
3155
3156 if (mhd) then
3157 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
3158 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
3159 end if
3160
3161 if (viscous) then
3162 if (chemistry) then
3163 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
3164 end if
3165
3166# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3167#if defined(MFC_OpenACC)
3168# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3169!$acc loop seq
3170# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3171#elif defined(MFC_OpenMP)
3172# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3173
3174# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3175#endif
3176 do i = 1, 2
3177 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3178 end do
3179 end if
3180
3181 ! Wave speed estimates (wave_speeds=1: direct, wave_speeds=2: pressure-based)
3182 if (wave_speeds == 1) then
3183 if (mhd) then
3184 ! MHD: use fast magnetosonic speed
3185 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
3186 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
3187 else if (hypoelasticity) then
3188 ! Elastic wave speed, Rodriguez et al. JCP (2019)
3189 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
3190 & /rho_l), &
3191 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
3192 & /rho_r))
3193 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
3194 & /rho_r), &
3195 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
3196 & /rho_l))
3197 else if (hyperelasticity) then
3198 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l), &
3199 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
3200 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r), &
3201 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
3202 else
3203 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3204 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3205 end if
3206
3207 if (hyper_cleaning) then
3208 ! Dedner GLM divergence cleaning, Dedner et al. JCP (2002)
3209 s_l = min(s_l, -hyper_cleaning_speed)
3210 s_r = max(s_r, hyper_cleaning_speed)
3211 end if
3212
3213 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
3214 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
3215 & - rho_r*(s_r - vel_r(dir_idx(1))))
3216 else if (wave_speeds == 2) then
3217 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3218
3219 pres_sr = pres_sl
3220
3221 ! Low Mach correction: Thornber et al. JCP (2008)
3222 ms_l = max(1._wp, &
3223 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
3224 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
3225 ms_r = max(1._wp, &
3226 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
3227 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
3228
3229 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3230 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3231
3232 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
3233 end if
3234
3235 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3236
3237 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_l)) + (5.e-1_wp - sign(5.e-1_wp, s_l))*(5.e-1_wp + sign(5.e-1_wp, &
3238 & s_r))
3239 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_r)) + (5.e-1_wp - sign(5.e-1_wp, s_l))*(5.e-1_wp + sign(5.e-1_wp, &
3240 & s_r))
3241
3242 ! HLL intercell flux: F* = (s_R*F_L - s_L*F_R + s_L*s_R*(U_R - U_L)) / (s_R - s_L) Low Mach correction
3243 if (low_mach == 1) then
3244 if (riemann_solver == 1 .or. riemann_solver == 5) then
3245# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3246 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3247# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3248 pcorr = 0._wp
3249# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3250
3251# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3252 if (low_mach == 1) then
3253# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3254 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3255# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3256 end if
3257# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3258 else if (riemann_solver == 2) then
3259# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3260 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3261# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3262 pcorr = 0._wp
3263# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3264
3265# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3266 if (low_mach == 1) then
3267# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3268 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
3269# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3270 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3271# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3272 else if (low_mach == 2) then
3273# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3274 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3275# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3276 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
3277# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3278 vel_l(dir_idx(1)) = vel_l_tmp
3279# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3280 vel_r(dir_idx(1)) = vel_r_tmp
3281# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3282 end if
3283# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3284 end if
3285 else
3286 pcorr = 0._wp
3287 end if
3288
3289 ! Mass
3290 if (.not. relativity) then
3291
3292# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3293#if defined(MFC_OpenACC)
3294# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3295!$acc loop seq
3296# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3297#elif defined(MFC_OpenMP)
3298# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3299
3300# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3301#endif
3302 do i = 1, eqn_idx%cont%end
3303 flux_rsz_vf(j, k, l, &
3304 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i) &
3305 & *vel_l(norm_dir) + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
3306 end do
3307 else if (relativity) then
3308
3309# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3310#if defined(MFC_OpenACC)
3311# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3312!$acc loop seq
3313# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3314#elif defined(MFC_OpenMP)
3315# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3316
3317# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3318#endif
3319 do i = 1, eqn_idx%cont%end
3320 flux_rsz_vf(j, k, l, &
3321 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
3322 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i))) &
3323 & /(s_m - s_p)
3324 end do
3325 end if
3326
3327 ! Momentum
3328 if (mhd .and. (.not. relativity)) then
3329
3330# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3331#if defined(MFC_OpenACC)
3332# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3333!$acc loop seq
3334# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3335#elif defined(MFC_OpenMP)
3336# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3337
3338# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3339#endif
3340 do i = 1, 3
3341 ! Flux of rho*v_i in the z direction = rho * v_i * v_z - B_i * B_z +
3342 ! delta_(z,i) * p_tot
3343 flux_rsz_vf(j, k, l, &
3344 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
3345 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
3346 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
3347 & ) + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
3348 end do
3349 else if (mhd .and. relativity) then
3350
3351# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3352#if defined(MFC_OpenACC)
3353# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3354!$acc loop seq
3355# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3356#elif defined(MFC_OpenMP)
3357# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3358
3359# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3360#endif
3361 do i = 1, 3
3362 ! Flux of m_i in the z direction = m_i * v_z - b_i/Gamma * B_z +
3363 ! delta_(z,i) * p_tot
3364 flux_rsz_vf(j, k, l, &
3365 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
3366 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
3367 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l &
3368 & + pres_mag%L)) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
3369 end do
3370 else if (bubbles_euler) then
3371
3372# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3373#if defined(MFC_OpenACC)
3374# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3375!$acc loop seq
3376# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3377#elif defined(MFC_OpenMP)
3378# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3379
3380# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3381#endif
3382 do i = 1, num_vels
3383 flux_rsz_vf(j, k, l, &
3384 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
3385 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
3386 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
3387 & *(pres_l - ptilde_l)) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
3388 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
3389 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
3390 end do
3391 else if (hypoelasticity) then
3392
3393# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3394#if defined(MFC_OpenACC)
3395# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3396!$acc loop seq
3397# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3398#elif defined(MFC_OpenMP)
3399# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3400
3401# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3402#endif
3403 do i = 1, num_vels
3404 flux_rsz_vf(j, k, l, &
3405 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
3406 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
3407 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
3408 & *pres_l - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
3409 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
3410 end do
3411 else
3412
3413# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3414#if defined(MFC_OpenACC)
3415# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3416!$acc loop seq
3417# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3418#elif defined(MFC_OpenMP)
3419# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3420
3421# 630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3422#endif
3423 do i = 1, num_vels
3424 flux_rsz_vf(j, k, l, &
3425 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
3426 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*pres_r) &
3427 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
3428 & *pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i)))) &
3429 & /(s_m - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) &
3430 & - vel_l(dir_idx(i)))
3431 end do
3432 end if
3433
3434 ! Energy
3435 if (mhd .and. (.not. relativity)) then
3436 ! energy flux = (E + p + p_mag) * v_z - B_z * (v_x*B_x + v_y*B_y + v_z*B_z)
3437# 646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3438 flux_rsz_vf(j, k, l, &
3439 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) &
3440 & - b%R(norm_dir)*(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
3441 & - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir) &
3442 & *(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) + s_m*s_p*(e_l &
3443 & - e_r))/(s_m - s_p)
3444# 653 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3445 else if (mhd .and. relativity) then
3446 ! energy flux = m_z - mass flux Hard-coded for single-component for now
3447 flux_rsz_vf(j, k, l, &
3448 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
3449 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l &
3450 & - e_r))/(s_m - s_p)
3451 else if (bubbles_euler) then
3452 flux_rsz_vf(j, k, l, &
3453 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
3454 & - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m &
3455 & - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
3456 else if (hypoelasticity) then
3457 flux_tau_l = 0._wp; flux_tau_r = 0._wp
3458
3459# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3460#if defined(MFC_OpenACC)
3461# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3462!$acc loop seq
3463# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3464#elif defined(MFC_OpenMP)
3465# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3466
3467# 666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3468#endif
3469 do i = 1, num_dims
3470 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
3471 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
3472 end do
3473 flux_rsz_vf(j, k, l, &
3474 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
3475 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r)) &
3476 & /(s_m - s_p)
3477 else
3478 flux_rsz_vf(j, k, l, &
3479 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1)) &
3480 & *(e_l + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
3481 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
3482 end if
3483
3484 ! Elastic Stresses
3485 if (hypoelasticity) then
3486 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
3487 flux_rsz_vf(j, k, l, &
3488 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
3489 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
3490 & - rho_r*tau_e_r(i)))/(s_m - s_p)
3491 end do
3492 end if
3493
3494 ! Advection flux and source: interface velocity for volume fraction transport
3495
3496# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3497#if defined(MFC_OpenACC)
3498# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3499!$acc loop seq
3500# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3501#elif defined(MFC_OpenMP)
3502# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3503
3504# 693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3505#endif
3506 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3507 flux_rsz_vf(j, k, l, i) = (ql_prim_rsz_vf(j, k, l, i) - qr_prim_rsz_vf(j + 1, &
3508 & k, l, i))*s_m*s_p/(s_m - s_p)
3509 flux_src_rsz_vf(j, k, l, i) = (s_m*qr_prim_rsz_vf(j + 1, k, l, &
3510 & i) - s_p*ql_prim_rsz_vf(j, k, l, i))/(s_m - s_p)
3511 end do
3512
3513 if (bubbles_euler) then
3514 ! From HLLC: Kills mass transport @ bubble gas density
3515 if (num_fluids > 1) then
3516 flux_rsz_vf(j, k, l, eqn_idx%cont%end) = 0._wp
3517 end if
3518 end if
3519
3520 if (chemistry) then
3521
3522# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3523#if defined(MFC_OpenACC)
3524# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3525!$acc loop seq
3526# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3527#elif defined(MFC_OpenMP)
3528# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3529
3530# 709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3531#endif
3532 do i = eqn_idx%species%beg, eqn_idx%species%end
3533 y_l = ql_prim_rsz_vf(j, k, l, i)
3534 y_r = qr_prim_rsz_vf(j + 1, k, l, i)
3535
3536 flux_rsz_vf(j, k, l, &
3537 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
3538 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
3539 flux_src_rsz_vf(j, k, l, i) = 0._wp
3540 end do
3541 end if
3542
3543 ! MHD: magnetic flux and Maxwell stress contributions
3544 if (mhd) then
3545 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
3546 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
3547
3548# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3549#if defined(MFC_OpenACC)
3550# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3551!$acc loop seq
3552# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3553#elif defined(MFC_OpenMP)
3554# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3555
3556# 725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3557#endif
3558 do i = 0, 1
3559 flux_rsx_vf(j, k, l, &
3560 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
3561 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
3562 & - b%R(2 + i)))/(s_m - s_p)
3563 end do
3564 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
3565 ! B_x d/dz flux = (1 - delta(x,z)) * (v_z * B_x - v_x * B_z) B_y
3566 ! d/dz flux = (1 - delta(y,z)) * (v_z * B_y - v_y * B_z) B_z d/dz
3567 ! flux = (1 - delta(z,z)) * (v_z * B_z - v_z * B_z)
3568
3569# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3570#if defined(MFC_OpenACC)
3571# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3572!$acc loop seq
3573# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3574#elif defined(MFC_OpenMP)
3575# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3576
3577# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3578#endif
3579 do i = 0, 2
3580 flux_rsz_vf(j, k, l, &
3581 & eqn_idx%B%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1) &
3582 & *b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1) &
3583 & *b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
3584 end do
3585
3586 if (hyper_cleaning) then
3587 ! propagate magnetic field divergence as a wave
3588 flux_rsz_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = flux_rsz_vf(j, k, l, &
3589 & eqn_idx%B%beg + norm_dir - 1) + (s_m*qr_prim_rsz_vf(j + 1, k, &
3590 & l, eqn_idx%psi) - s_p*ql_prim_rsz_vf(j, k, l, &
3591 & eqn_idx%psi))/(s_m - s_p)
3592
3593 flux_rsz_vf(j, k, l, &
3594 & eqn_idx%psi) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) &
3595 & - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsz_vf(j, k, l, &
3596 & eqn_idx%psi) - qr_prim_rsz_vf(j + 1, k, l, &
3597 & eqn_idx%psi)))/(s_m - s_p)
3598 else
3599 flux_rsz_vf(j, k, l, &
3600 & eqn_idx%B%beg + norm_dir - 1) &
3601 & = 0._wp ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
3602 end if
3603 end if
3604 flux_src_rsz_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
3605 end if
3606
3607# 793 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3608 end do
3609 end do
3610 end do
3611
3612# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3613#if defined(MFC_OpenACC)
3614# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3615!$acc end parallel loop
3616# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3617#elif defined(MFC_OpenMP)
3618# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3619
3620# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3621!$omp end target teams loop
3622# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3623#endif
3624 end if
3625# 799 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3626
3627 if (viscous .or. dummy) then
3628 if (weno_re_flux) then
3629 call s_compute_viscous_source_flux(ql_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3630 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3631 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3632 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3633 & qr_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3634 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3635 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3636 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, &
3637 & iy, iz)
3638 else
3639 call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3640 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3641 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3642 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3643 & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3644 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3645 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3646 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, &
3647 & iy, iz)
3648 end if
3649 end if
3650
3651 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
3652
3653 end subroutine s_hll_riemann_solver
3654
3655 !> Lax-Friedrichs (Rusanov) approximate Riemann solver
3656 subroutine s_lf_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, &
3657
3658 & dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, &
3659 & dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
3660
3661 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, ql_prim_rsy_vf, &
3662 & qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf
3663 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
3664 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
3665 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
3666 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
3667
3668 ! Intercell fluxes
3669 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
3670 real(wp) :: flux_tau_l, flux_tau_r
3671 integer, intent(in) :: norm_dir
3672 type(int_bounds_info), intent(in) :: ix, iy, iz
3673
3674# 856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3675 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
3676 real(wp), dimension(num_vels) :: vel_l, vel_r
3677 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
3678 real(wp), dimension(num_species) :: ys_l, ys_r
3679 real(wp), dimension(num_species) :: cp_il, cp_ir, xs_l, xs_r, gamma_il, gamma_ir
3680 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
3681 !> Averaged velocity gradient tensor `d(vel_i)/d(coord_j)`.
3682 real(wp), dimension(num_dims, num_dims) :: vel_grad_l, vel_grad_r
3683# 865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3684 real(wp) :: rho_l, rho_r
3685 real(wp) :: pres_l, pres_r
3686 real(wp) :: e_l, e_r
3687 real(wp) :: h_l, h_r
3688 real(wp) :: cp_avg, cv_avg, t_avg, eps, c_sum_yi_phi
3689 real(wp) :: t_l, t_r
3690 real(wp) :: y_l, y_r
3691 real(wp) :: mw_l, mw_r
3692 real(wp) :: r_gas_l, r_gas_r
3693 real(wp) :: cp_l, cp_r
3694 real(wp) :: cv_l, cv_r
3695 real(wp) :: gamm_l, gamm_r
3696 real(wp) :: gamma_l, gamma_r
3697 real(wp) :: pi_inf_l, pi_inf_r
3698 real(wp) :: qv_l, qv_r
3699 real(wp) :: c_l, c_r
3700 real(wp), dimension(6) :: tau_e_l, tau_e_r
3701 real(wp) :: g_l, g_r
3702 real(wp), dimension(2) :: re_l, re_r
3703 real(wp), dimension(3) :: xi_field_l, xi_field_r
3704 real(wp) :: rho_avg
3705 real(wp) :: h_avg
3706 real(wp) :: gamma_avg
3707 real(wp) :: c_avg
3708 real(wp) :: s_l, s_r, s_m, s_p, s_s
3709 real(wp) :: xi_m, xi_p
3710 real(wp) :: ptilde_l, ptilde_r
3711 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
3712 real(wp) :: vel_l_tmp, vel_r_tmp
3713 real(wp) :: ms_l, ms_r, pres_sl, pres_sr
3714 real(wp) :: alpha_l_sum, alpha_r_sum
3715 real(wp) :: zcoef, pcorr !< low Mach number correction
3716 type(riemann_states) :: c_fast, pres_mag
3717 type(riemann_states_vec3) :: b
3718 type(riemann_states) :: ga !< Gamma (Lorentz factor)
3719 type(riemann_states) :: vdotb, b2
3720 type(riemann_states_vec3) :: b4 !< 4-magnetic field components (spatial: b4x, b4y, b4z)
3721 type(riemann_states_vec3) :: cm !< Conservative momentum variables
3722 integer :: i, j, k, l, q !< Generic loop iterators
3723 integer, dimension(3) :: idx_right_phys !< Physical (j,k,l) indices for right state.
3724 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
3725
3726 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
3727 & dql_prim_dy_vf, dql_prim_dz_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, &
3728 & dqr_prim_dz_vf, norm_dir, ix, iy, iz)
3729
3730 ! Reshaping inputted data based on dimensional splitting direction
3731 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
3732# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3733 if (norm_dir == 1) then
3734
3735# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3736
3737# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3738#if defined(MFC_OpenACC)
3739# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3740!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, Ys_L, Ys_R, xi_field_L, xi_field_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, c_fast, pres_mag, B, Ga, vdotB, B2, b4, cm, pcorr, zcoef, vel_grad_L, vel_grad_R, idx_right_phys, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, c_avg, pres_L, pres_R, rho_L, rho_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, c_L, c_R, E_L, E_R, H_L, H_R, ptilde_L, ptilde_R, s_M, s_P, xi_M, xi_P, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, Cp_L, Cp_R, Cv_L, Cv_R, R_gas_L, R_gas_R, MW_L, MW_R, T_L, T_R, Y_L, Y_R)
3741# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3742#elif defined(MFC_OpenMP)
3743# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3744
3745# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3746
3747# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3748
3749# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3750!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, Ys_L, Ys_R, xi_field_L, xi_field_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, c_fast, pres_mag, B, Ga, vdotB, B2, b4, cm, pcorr, zcoef, vel_grad_L, vel_grad_R, idx_right_phys, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, c_avg, pres_L, pres_R, rho_L, rho_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, c_L, c_R, E_L, E_R, H_L, H_R, ptilde_L, ptilde_R, s_M, s_P, xi_M, xi_P, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, Cp_L, Cp_R, Cv_L, Cv_R, R_gas_L, R_gas_R, MW_L, MW_R, T_L, T_R, Y_L, Y_R)
3751# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3752#endif
3753# 924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3754 do l = is3%beg, is3%end
3755 do k = is2%beg, is2%end
3756 do j = is1%beg, is1%end
3757
3758# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3759#if defined(MFC_OpenACC)
3760# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3761!$acc loop seq
3762# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3763#elif defined(MFC_OpenMP)
3764# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3765
3766# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3767#endif
3768 do i = 1, eqn_idx%cont%end
3769 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
3770 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
3771 end do
3772
3773 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3774
3775
3776# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3777#if defined(MFC_OpenACC)
3778# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3779!$acc loop seq
3780# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3781#elif defined(MFC_OpenMP)
3782# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3783
3784# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3785#endif
3786 do i = 1, num_vels
3787 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
3788 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
3789 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3790 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3791 end do
3792
3793
3794# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3795#if defined(MFC_OpenACC)
3796# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3797!$acc loop seq
3798# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3799#elif defined(MFC_OpenMP)
3800# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3801
3802# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3803#endif
3804 do i = 1, num_fluids
3805 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3806 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
3807 end do
3808
3809 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
3810 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
3811
3812 if (mhd) then
3813 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
3814 b%L(1) = bx0
3815 b%R(1) = bx0
3816 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
3817 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg)
3818 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
3819 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 1)
3820 else ! 2D/3D: Bx, By, Bz as variables
3821 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
3822 b%R(1) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg)
3823 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
3824 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 1)
3825 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
3826 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 2)
3827 end if
3828 end if
3829
3830 rho_l = 0._wp
3831 gamma_l = 0._wp
3832 pi_inf_l = 0._wp
3833 qv_l = 0._wp
3834
3835 rho_r = 0._wp
3836 gamma_r = 0._wp
3837 pi_inf_r = 0._wp
3838 qv_r = 0._wp
3839
3840 alpha_l_sum = 0._wp
3841 alpha_r_sum = 0._wp
3842
3843 pres_mag%L = 0._wp
3844 pres_mag%R = 0._wp
3845
3846 if (mpp_lim) then
3847
3848# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3849#if defined(MFC_OpenACC)
3850# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3851!$acc loop seq
3852# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3853#elif defined(MFC_OpenMP)
3854# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3855
3856# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3857#endif
3858 do i = 1, num_fluids
3859 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
3860 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
3861 alpha_l_sum = alpha_l_sum + alpha_l(i)
3862 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
3863 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
3864 alpha_r_sum = alpha_r_sum + alpha_r(i)
3865 end do
3866
3867 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
3868 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
3869 end if
3870
3871
3872# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3873#if defined(MFC_OpenACC)
3874# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3875!$acc loop seq
3876# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3877#elif defined(MFC_OpenMP)
3878# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3879
3880# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3881#endif
3882 do i = 1, num_fluids
3883 rho_l = rho_l + alpha_rho_l(i)
3884 gamma_l = gamma_l + alpha_l(i)*gammas(i)
3885 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
3886 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
3887
3888 rho_r = rho_r + alpha_rho_r(i)
3889 gamma_r = gamma_r + alpha_r(i)*gammas(i)
3890 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
3891 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
3892 end do
3893
3894 if (viscous) then
3895
3896# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3897#if defined(MFC_OpenACC)
3898# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3899!$acc loop seq
3900# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3901#elif defined(MFC_OpenMP)
3902# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3903
3904# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3905#endif
3906 do i = 1, 2
3907 re_l(i) = dflt_real
3908 re_r(i) = dflt_real
3909
3910 if (re_size(i) > 0) re_l(i) = 0._wp
3911 if (re_size(i) > 0) re_r(i) = 0._wp
3912
3913
3914# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3915#if defined(MFC_OpenACC)
3916# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3917!$acc loop seq
3918# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3919#elif defined(MFC_OpenMP)
3920# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3921
3922# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3923#endif
3924 do q = 1, re_size(i)
3925 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
3926 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
3927 end do
3928
3929 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
3930 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
3931 end do
3932 end if
3933
3934 if (chemistry) then
3935
3936# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3937#if defined(MFC_OpenACC)
3938# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3939!$acc loop seq
3940# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3941#elif defined(MFC_OpenMP)
3942# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3943
3944# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3945#endif
3946 do i = eqn_idx%species%beg, eqn_idx%species%end
3947 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
3948 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
3949 end do
3950
3951 call get_mixture_molecular_weight(ys_l, mw_l)
3952 call get_mixture_molecular_weight(ys_r, mw_r)
3953
3954# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3955 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
3956 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
3957# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3958
3959 r_gas_l = gas_constant/mw_l
3960 r_gas_r = gas_constant/mw_r
3961 t_l = pres_l/rho_l/r_gas_l
3962 t_r = pres_r/rho_r/r_gas_r
3963
3964 call get_species_specific_heats_r(t_l, cp_il)
3965 call get_species_specific_heats_r(t_r, cp_ir)
3966
3967 if (chem_params%gamma_method == 1) then
3968 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
3969 gamma_il = cp_il/(cp_il - 1.0_wp)
3970 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
3971
3972 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
3973 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
3974 else if (chem_params%gamma_method == 2) then
3975 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
3976 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
3977 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
3978 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
3979 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
3980
3981 gamm_l = cp_l/cv_l
3982 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
3983 gamm_r = cp_r/cv_r
3984 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
3985 end if
3986
3987 call get_mixture_energy_mass(t_l, ys_l, e_l)
3988 call get_mixture_energy_mass(t_r, ys_r, e_r)
3989
3990 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
3991 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
3992 h_l = (e_l + pres_l)/rho_l
3993 h_r = (e_r + pres_r)/rho_r
3994 else if (mhd .and. relativity) then
3995# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3996 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
3997 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
3998 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
3999 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
4000
4001 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
4002 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
4003 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
4004 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
4005
4006 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
4007 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
4008
4009 ! Hard-coded EOS
4010 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
4011 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
4012
4013 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
4014 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
4015
4016 e_l = rho_l*h_l*ga%L**2 - pres_l + 0.5_wp*(b2%L + vel_l_rms*b2%L - vdotb%L**2._wp) - rho_l*ga%L
4017 e_r = rho_r*h_r*ga%R**2 - pres_r + 0.5_wp*(b2%R + vel_r_rms*b2%R - vdotb%R**2._wp) - rho_r*ga%R
4018# 1112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4019 else if (mhd .and. .not. relativity) then
4020 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
4021 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
4022 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
4023 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r &
4024 & + pres_mag%R ! includes magnetic energy
4025 h_l = (e_l + pres_l - pres_mag%L)/rho_l
4026 h_r = (e_r + pres_r - pres_mag%R) &
4027 & /rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
4028 else
4029 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
4030 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
4031 h_l = (e_l + pres_l)/rho_l
4032 h_r = (e_r + pres_r)/rho_r
4033 end if
4034
4035 ! elastic energy update
4036 if (hypoelasticity) then
4037 g_l = 0._wp; g_r = 0._wp
4038
4039
4040# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4041#if defined(MFC_OpenACC)
4042# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4043!$acc loop seq
4044# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4045#elif defined(MFC_OpenMP)
4046# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4047
4048# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4049#endif
4050 do i = 1, num_fluids
4051 g_l = g_l + alpha_l(i)*gs_rs(i)
4052 g_r = g_r + alpha_r(i)*gs_rs(i)
4053 end do
4054
4055 if (cont_damage) then
4056 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
4057 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
4058 end if
4059
4060 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4061 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
4062 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
4063 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
4064 if ((g_l > 1000) .and. (g_r > 1000)) then
4065 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4066 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4067 ! Double for shear stresses
4068 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
4069 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4070 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4071 end if
4072 end if
4073 end do
4074 end if
4075
4076 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, c_l, &
4077 & qv_l)
4078
4079 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, c_r, &
4080 & qv_r)
4081
4082 if (mhd) then
4083 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
4084 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
4085 end if
4086
4087 s_l = 0._wp; s_r = 0._wp
4088
4089
4090# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4091#if defined(MFC_OpenACC)
4092# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4093!$acc loop seq
4094# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4095#elif defined(MFC_OpenMP)
4096# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4097
4098# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4099#endif
4100 do i = 1, num_dims
4101 s_l = s_l + vel_l(i)**2._wp
4102 s_r = s_r + vel_r(i)**2._wp
4103 end do
4104
4105 s_l = sqrt(s_l)
4106 s_r = sqrt(s_r)
4107
4108 s_p = max(s_l, s_r) + max(c_l, c_r)
4109 s_m = -s_p
4110
4111 s_l = s_m
4112 s_r = s_p
4113
4114 ! Low Mach correction
4115 if (low_mach == 1) then
4116 if (riemann_solver == 1 .or. riemann_solver == 5) then
4117# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4118 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4119# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4120 pcorr = 0._wp
4121# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4122
4123# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4124 if (low_mach == 1) then
4125# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4126 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4127# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4128 end if
4129# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4130 else if (riemann_solver == 2) then
4131# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4132 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4133# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4134 pcorr = 0._wp
4135# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4136
4137# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4138 if (low_mach == 1) then
4139# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4140 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
4141# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4142 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
4143# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4144 else if (low_mach == 2) then
4145# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4146 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
4147# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4148 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
4149# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4150 vel_l(dir_idx(1)) = vel_l_tmp
4151# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4152 vel_r(dir_idx(1)) = vel_r_tmp
4153# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4154 end if
4155# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4156 end if
4157 else
4158 pcorr = 0._wp
4159 end if
4160
4161 ! Mass
4162 if (.not. relativity) then
4163
4164# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4165#if defined(MFC_OpenACC)
4166# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4167!$acc loop seq
4168# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4169#elif defined(MFC_OpenMP)
4170# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4171
4172# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4173#endif
4174 do i = 1, eqn_idx%cont%end
4175 flux_rsx_vf(j, k, l, &
4176 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i) &
4177 & *vel_l(norm_dir) + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
4178 end do
4179 else if (relativity) then
4180
4181# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4182#if defined(MFC_OpenACC)
4183# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4184!$acc loop seq
4185# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4186#elif defined(MFC_OpenMP)
4187# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4188
4189# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4190#endif
4191 do i = 1, eqn_idx%cont%end
4192 flux_rsx_vf(j, k, l, &
4193 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
4194 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i))) &
4195 & /(s_m - s_p)
4196 end do
4197 end if
4198
4199 ! Momentum
4200 if (mhd .and. (.not. relativity)) then
4201
4202# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4203#if defined(MFC_OpenACC)
4204# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4205!$acc loop seq
4206# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4207#elif defined(MFC_OpenMP)
4208# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4209
4210# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4211#endif
4212 do i = 1, 3
4213 ! Flux of rho*v_i in the x direction = rho * v_i * v_x - B_i * B_x +
4214 ! delta_(x,i) * p_tot
4215 flux_rsx_vf(j, k, l, &
4216 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
4217 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
4218 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
4219 & ) + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
4220 end do
4221 else if (mhd .and. relativity) then
4222
4223# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4224#if defined(MFC_OpenACC)
4225# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4226!$acc loop seq
4227# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4228#elif defined(MFC_OpenMP)
4229# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4230
4231# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4232#endif
4233 do i = 1, 3
4234 ! Flux of m_i in the x direction = m_i * v_x - b_i/Gamma * B_x +
4235 ! delta_(x,i) * p_tot
4236 flux_rsx_vf(j, k, l, &
4237 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
4238 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
4239 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l &
4240 & + pres_mag%L)) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
4241 end do
4242 else if (bubbles_euler) then
4243
4244# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4245#if defined(MFC_OpenACC)
4246# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4247!$acc loop seq
4248# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4249#elif defined(MFC_OpenMP)
4250# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4251
4252# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4253#endif
4254 do i = 1, num_vels
4255 flux_rsx_vf(j, k, l, &
4256 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
4257 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
4258 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
4259 & *(pres_l - ptilde_l)) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4260 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
4261 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4262 end do
4263 else if (hypoelasticity) then
4264
4265# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4266#if defined(MFC_OpenACC)
4267# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4268!$acc loop seq
4269# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4270#elif defined(MFC_OpenMP)
4271# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4272
4273# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4274#endif
4275 do i = 1, num_vels
4276 flux_rsx_vf(j, k, l, &
4277 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
4278 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
4279 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
4280 & *pres_l - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4281 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
4282 end do
4283 else
4284
4285# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4286#if defined(MFC_OpenACC)
4287# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4288!$acc loop seq
4289# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4290#elif defined(MFC_OpenMP)
4291# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4292
4293# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4294#endif
4295 do i = 1, num_vels
4296 flux_rsx_vf(j, k, l, &
4297 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
4298 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*pres_r) &
4299 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
4300 & *pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i)))) &
4301 & /(s_m - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) &
4302 & - vel_l(dir_idx(i)))
4303 end do
4304 end if
4305
4306 ! Energy
4307 if (mhd .and. (.not. relativity)) then
4308 ! energy flux = (E + p + p_mag) * v_x - B_x * (v_x*B_x + v_y*B_y + v_z*B_z)
4309# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4310 flux_rsx_vf(j, k, l, &
4311 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) &
4312 & - b%R(norm_dir)*(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
4313 & - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir) &
4314 & *(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) + s_m*s_p*(e_l &
4315 & - e_r))/(s_m - s_p)
4316# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4317 else if (mhd .and. relativity) then
4318 ! energy flux = m_x - mass flux Hard-coded for single-component for now
4319 flux_rsx_vf(j, k, l, &
4320 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
4321 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l &
4322 & - e_r))/(s_m - s_p)
4323 else if (bubbles_euler) then
4324 flux_rsx_vf(j, k, l, &
4325 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
4326 & - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m &
4327 & - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
4328 else if (hypoelasticity) then
4329 flux_tau_l = 0._wp; flux_tau_r = 0._wp
4330
4331# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4332#if defined(MFC_OpenACC)
4333# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4334!$acc loop seq
4335# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4336#elif defined(MFC_OpenMP)
4337# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4338
4339# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4340#endif
4341 do i = 1, num_dims
4342 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
4343 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
4344 end do
4345 flux_rsx_vf(j, k, l, &
4346 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
4347 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r)) &
4348 & /(s_m - s_p)
4349 else
4350 flux_rsx_vf(j, k, l, &
4351 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1)) &
4352 & *(e_l + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
4353 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
4354 end if
4355
4356 ! Elastic Stresses
4357 if (hypoelasticity) then
4358 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
4359 flux_rsx_vf(j, k, l, &
4360 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
4361 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
4362 & - rho_r*tau_e_r(i)))/(s_m - s_p)
4363 end do
4364 end if
4365
4366 ! Advection flux and source: interface velocity for volume fraction transport
4367
4368# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4369#if defined(MFC_OpenACC)
4370# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4371!$acc loop seq
4372# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4373#elif defined(MFC_OpenMP)
4374# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4375
4376# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4377#endif
4378 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4379 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j + 1, &
4380 & k, l, i))*s_m*s_p/(s_m - s_p)
4381 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j + 1, k, l, &
4382 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
4383 end do
4384
4385 if (bubbles_euler) then
4386 ! From HLLC: Kills mass transport @ bubble gas density
4387 if (num_fluids > 1) then
4388 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
4389 end if
4390 end if
4391
4392 if (chemistry) then
4393
4394# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4395#if defined(MFC_OpenACC)
4396# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4397!$acc loop seq
4398# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4399#elif defined(MFC_OpenMP)
4400# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4401
4402# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4403#endif
4404 do i = eqn_idx%species%beg, eqn_idx%species%end
4405 y_l = ql_prim_rsx_vf(j, k, l, i)
4406 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
4407
4408 flux_rsx_vf(j, k, l, &
4409 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
4410 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
4411 flux_src_rsx_vf(j, k, l, i) = 0._wp
4412 end do
4413 end if
4414
4415 ! MHD: magnetic flux and Maxwell stress contributions
4416 if (mhd) then
4417 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
4418 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
4419
4420# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4421#if defined(MFC_OpenACC)
4422# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4423!$acc loop seq
4424# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4425#elif defined(MFC_OpenMP)
4426# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4427
4428# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4429#endif
4430 do i = 0, 1
4431 flux_rsx_vf(j, k, l, &
4432 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
4433 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
4434 & - b%R(2 + i)))/(s_m - s_p)
4435 end do
4436 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
4437 ! B_x d/dx flux = (1 - delta(x,x)) * (v_x * B_x - v_x * B_x) B_y
4438 ! d/dx flux = (1 - delta(y,x)) * (v_x * B_y - v_y * B_x) B_z d/dx
4439 ! flux = (1 - delta(z,x)) * (v_x * B_z - v_z * B_x)
4440
4441# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4442#if defined(MFC_OpenACC)
4443# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4444!$acc loop seq
4445# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4446#elif defined(MFC_OpenMP)
4447# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4448
4449# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4450#endif
4451 do i = 0, 2
4452 flux_rsx_vf(j, k, l, &
4453 & eqn_idx%B%beg + i) = (1 - dir_flg(i + 1))*(s_m*(vel_r(dir_idx(1)) &
4454 & *b%R(i + 1) - vel_r(i + 1)*b%R(norm_dir)) - s_p*(vel_l(dir_idx(1)) &
4455 & *b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) &
4456 & - b%R(i + 1)))/(s_m - s_p)
4457 end do
4458 end if
4459 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
4460 end if
4461
4462# 1403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4463 end do
4464 end do
4465 end do
4466
4467# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4468#if defined(MFC_OpenACC)
4469# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4470!$acc end parallel loop
4471# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4472#elif defined(MFC_OpenMP)
4473# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4474
4475# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4476!$omp end target teams loop
4477# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4478#endif
4479 end if
4480# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4481 if (norm_dir == 2) then
4482
4483# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4484
4485# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4486#if defined(MFC_OpenACC)
4487# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4488!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, Ys_L, Ys_R, xi_field_L, xi_field_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, c_fast, pres_mag, B, Ga, vdotB, B2, b4, cm, pcorr, zcoef, vel_grad_L, vel_grad_R, idx_right_phys, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, c_avg, pres_L, pres_R, rho_L, rho_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, c_L, c_R, E_L, E_R, H_L, H_R, ptilde_L, ptilde_R, s_M, s_P, xi_M, xi_P, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, Cp_L, Cp_R, Cv_L, Cv_R, R_gas_L, R_gas_R, MW_L, MW_R, T_L, T_R, Y_L, Y_R)
4489# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4490#elif defined(MFC_OpenMP)
4491# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4492
4493# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4494
4495# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4496
4497# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4498!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, Ys_L, Ys_R, xi_field_L, xi_field_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, c_fast, pres_mag, B, Ga, vdotB, B2, b4, cm, pcorr, zcoef, vel_grad_L, vel_grad_R, idx_right_phys, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, c_avg, pres_L, pres_R, rho_L, rho_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, c_L, c_R, E_L, E_R, H_L, H_R, ptilde_L, ptilde_R, s_M, s_P, xi_M, xi_P, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, Cp_L, Cp_R, Cv_L, Cv_R, R_gas_L, R_gas_R, MW_L, MW_R, T_L, T_R, Y_L, Y_R)
4499# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4500#endif
4501# 924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4502 do l = is3%beg, is3%end
4503 do k = is2%beg, is2%end
4504 do j = is1%beg, is1%end
4505
4506# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4507#if defined(MFC_OpenACC)
4508# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4509!$acc loop seq
4510# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4511#elif defined(MFC_OpenMP)
4512# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4513
4514# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4515#endif
4516 do i = 1, eqn_idx%cont%end
4517 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
4518 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
4519 end do
4520
4521 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4522
4523
4524# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4525#if defined(MFC_OpenACC)
4526# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4527!$acc loop seq
4528# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4529#elif defined(MFC_OpenMP)
4530# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4531
4532# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4533#endif
4534 do i = 1, num_vels
4535 vel_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%cont%end + i)
4536 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%cont%end + i)
4537 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4538 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4539 end do
4540
4541
4542# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4543#if defined(MFC_OpenACC)
4544# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4545!$acc loop seq
4546# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4547#elif defined(MFC_OpenMP)
4548# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4549
4550# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4551#endif
4552 do i = 1, num_fluids
4553 alpha_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)
4554 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)
4555 end do
4556
4557 pres_l = ql_prim_rsy_vf(j, k, l, eqn_idx%E)
4558 pres_r = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E)
4559
4560 if (mhd) then
4561 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
4562 b%L(1) = bx0
4563 b%R(1) = bx0
4564 b%L(2) = ql_prim_rsy_vf(j, k, l, eqn_idx%B%beg)
4565 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%B%beg)
4566 b%L(3) = ql_prim_rsy_vf(j, k, l, eqn_idx%B%beg + 1)
4567 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%B%beg + 1)
4568 else ! 2D/3D: Bx, By, Bz as variables
4569 b%L(1) = ql_prim_rsy_vf(j, k, l, eqn_idx%B%beg)
4570 b%R(1) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%B%beg)
4571 b%L(2) = ql_prim_rsy_vf(j, k, l, eqn_idx%B%beg + 1)
4572 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%B%beg + 1)
4573 b%L(3) = ql_prim_rsy_vf(j, k, l, eqn_idx%B%beg + 2)
4574 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%B%beg + 2)
4575 end if
4576 end if
4577
4578 rho_l = 0._wp
4579 gamma_l = 0._wp
4580 pi_inf_l = 0._wp
4581 qv_l = 0._wp
4582
4583 rho_r = 0._wp
4584 gamma_r = 0._wp
4585 pi_inf_r = 0._wp
4586 qv_r = 0._wp
4587
4588 alpha_l_sum = 0._wp
4589 alpha_r_sum = 0._wp
4590
4591 pres_mag%L = 0._wp
4592 pres_mag%R = 0._wp
4593
4594 if (mpp_lim) then
4595
4596# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4597#if defined(MFC_OpenACC)
4598# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4599!$acc loop seq
4600# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4601#elif defined(MFC_OpenMP)
4602# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4603
4604# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4605#endif
4606 do i = 1, num_fluids
4607 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
4608 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
4609 alpha_l_sum = alpha_l_sum + alpha_l(i)
4610 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
4611 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
4612 alpha_r_sum = alpha_r_sum + alpha_r(i)
4613 end do
4614
4615 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
4616 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
4617 end if
4618
4619
4620# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4621#if defined(MFC_OpenACC)
4622# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4623!$acc loop seq
4624# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4625#elif defined(MFC_OpenMP)
4626# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4627
4628# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4629#endif
4630 do i = 1, num_fluids
4631 rho_l = rho_l + alpha_rho_l(i)
4632 gamma_l = gamma_l + alpha_l(i)*gammas(i)
4633 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
4634 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
4635
4636 rho_r = rho_r + alpha_rho_r(i)
4637 gamma_r = gamma_r + alpha_r(i)*gammas(i)
4638 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
4639 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
4640 end do
4641
4642 if (viscous) then
4643
4644# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4645#if defined(MFC_OpenACC)
4646# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4647!$acc loop seq
4648# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4649#elif defined(MFC_OpenMP)
4650# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4651
4652# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4653#endif
4654 do i = 1, 2
4655 re_l(i) = dflt_real
4656 re_r(i) = dflt_real
4657
4658 if (re_size(i) > 0) re_l(i) = 0._wp
4659 if (re_size(i) > 0) re_r(i) = 0._wp
4660
4661
4662# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4663#if defined(MFC_OpenACC)
4664# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4665!$acc loop seq
4666# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4667#elif defined(MFC_OpenMP)
4668# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4669
4670# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4671#endif
4672 do q = 1, re_size(i)
4673 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
4674 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
4675 end do
4676
4677 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
4678 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
4679 end do
4680 end if
4681
4682 if (chemistry) then
4683
4684# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4685#if defined(MFC_OpenACC)
4686# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4687!$acc loop seq
4688# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4689#elif defined(MFC_OpenMP)
4690# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4691
4692# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4693#endif
4694 do i = eqn_idx%species%beg, eqn_idx%species%end
4695 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsy_vf(j, k, l, i)
4696 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsy_vf(j + 1, k, l, i)
4697 end do
4698
4699 call get_mixture_molecular_weight(ys_l, mw_l)
4700 call get_mixture_molecular_weight(ys_r, mw_r)
4701
4702# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4703 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
4704 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
4705# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4706
4707 r_gas_l = gas_constant/mw_l
4708 r_gas_r = gas_constant/mw_r
4709 t_l = pres_l/rho_l/r_gas_l
4710 t_r = pres_r/rho_r/r_gas_r
4711
4712 call get_species_specific_heats_r(t_l, cp_il)
4713 call get_species_specific_heats_r(t_r, cp_ir)
4714
4715 if (chem_params%gamma_method == 1) then
4716 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
4717 gamma_il = cp_il/(cp_il - 1.0_wp)
4718 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
4719
4720 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
4721 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
4722 else if (chem_params%gamma_method == 2) then
4723 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
4724 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
4725 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
4726 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
4727 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
4728
4729 gamm_l = cp_l/cv_l
4730 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
4731 gamm_r = cp_r/cv_r
4732 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
4733 end if
4734
4735 call get_mixture_energy_mass(t_l, ys_l, e_l)
4736 call get_mixture_energy_mass(t_r, ys_r, e_r)
4737
4738 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
4739 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
4740 h_l = (e_l + pres_l)/rho_l
4741 h_r = (e_r + pres_r)/rho_r
4742 else if (mhd .and. relativity) then
4743# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4744 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
4745 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
4746 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
4747 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
4748
4749 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
4750 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
4751 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
4752 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
4753
4754 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
4755 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
4756
4757 ! Hard-coded EOS
4758 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
4759 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
4760
4761 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
4762 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
4763
4764 e_l = rho_l*h_l*ga%L**2 - pres_l + 0.5_wp*(b2%L + vel_l_rms*b2%L - vdotb%L**2._wp) - rho_l*ga%L
4765 e_r = rho_r*h_r*ga%R**2 - pres_r + 0.5_wp*(b2%R + vel_r_rms*b2%R - vdotb%R**2._wp) - rho_r*ga%R
4766# 1112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4767 else if (mhd .and. .not. relativity) then
4768 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
4769 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
4770 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
4771 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r &
4772 & + pres_mag%R ! includes magnetic energy
4773 h_l = (e_l + pres_l - pres_mag%L)/rho_l
4774 h_r = (e_r + pres_r - pres_mag%R) &
4775 & /rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
4776 else
4777 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
4778 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
4779 h_l = (e_l + pres_l)/rho_l
4780 h_r = (e_r + pres_r)/rho_r
4781 end if
4782
4783 ! elastic energy update
4784 if (hypoelasticity) then
4785 g_l = 0._wp; g_r = 0._wp
4786
4787
4788# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4789#if defined(MFC_OpenACC)
4790# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4791!$acc loop seq
4792# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4793#elif defined(MFC_OpenMP)
4794# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4795
4796# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4797#endif
4798 do i = 1, num_fluids
4799 g_l = g_l + alpha_l(i)*gs_rs(i)
4800 g_r = g_r + alpha_r(i)*gs_rs(i)
4801 end do
4802
4803 if (cont_damage) then
4804 g_l = g_l*max((1._wp - ql_prim_rsy_vf(j, k, l, eqn_idx%damage)), 0._wp)
4805 g_r = g_r*max((1._wp - qr_prim_rsy_vf(j, k, l, eqn_idx%damage)), 0._wp)
4806 end if
4807
4808 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4809 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
4810 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
4811 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
4812 if ((g_l > 1000) .and. (g_r > 1000)) then
4813 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4814 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4815 ! Double for shear stresses
4816 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
4817 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4818 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4819 end if
4820 end if
4821 end do
4822 end if
4823
4824 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, c_l, &
4825 & qv_l)
4826
4827 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, c_r, &
4828 & qv_r)
4829
4830 if (mhd) then
4831 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
4832 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
4833 end if
4834
4835 s_l = 0._wp; s_r = 0._wp
4836
4837
4838# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4839#if defined(MFC_OpenACC)
4840# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4841!$acc loop seq
4842# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4843#elif defined(MFC_OpenMP)
4844# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4845
4846# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4847#endif
4848 do i = 1, num_dims
4849 s_l = s_l + vel_l(i)**2._wp
4850 s_r = s_r + vel_r(i)**2._wp
4851 end do
4852
4853 s_l = sqrt(s_l)
4854 s_r = sqrt(s_r)
4855
4856 s_p = max(s_l, s_r) + max(c_l, c_r)
4857 s_m = -s_p
4858
4859 s_l = s_m
4860 s_r = s_p
4861
4862 ! Low Mach correction
4863 if (low_mach == 1) then
4864 if (riemann_solver == 1 .or. riemann_solver == 5) then
4865# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4866 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4867# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4868 pcorr = 0._wp
4869# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4870
4871# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4872 if (low_mach == 1) then
4873# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4874 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4875# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4876 end if
4877# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4878 else if (riemann_solver == 2) then
4879# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4880 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4881# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4882 pcorr = 0._wp
4883# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4884
4885# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4886 if (low_mach == 1) then
4887# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4888 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
4889# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4890 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
4891# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4892 else if (low_mach == 2) then
4893# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4894 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
4895# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4896 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
4897# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4898 vel_l(dir_idx(1)) = vel_l_tmp
4899# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4900 vel_r(dir_idx(1)) = vel_r_tmp
4901# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4902 end if
4903# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4904 end if
4905 else
4906 pcorr = 0._wp
4907 end if
4908
4909 ! Mass
4910 if (.not. relativity) then
4911
4912# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4913#if defined(MFC_OpenACC)
4914# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4915!$acc loop seq
4916# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4917#elif defined(MFC_OpenMP)
4918# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4919
4920# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4921#endif
4922 do i = 1, eqn_idx%cont%end
4923 flux_rsy_vf(j, k, l, &
4924 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i) &
4925 & *vel_l(norm_dir) + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
4926 end do
4927 else if (relativity) then
4928
4929# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4930#if defined(MFC_OpenACC)
4931# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4932!$acc loop seq
4933# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4934#elif defined(MFC_OpenMP)
4935# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4936
4937# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4938#endif
4939 do i = 1, eqn_idx%cont%end
4940 flux_rsy_vf(j, k, l, &
4941 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
4942 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i))) &
4943 & /(s_m - s_p)
4944 end do
4945 end if
4946
4947 ! Momentum
4948 if (mhd .and. (.not. relativity)) then
4949
4950# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4951#if defined(MFC_OpenACC)
4952# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4953!$acc loop seq
4954# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4955#elif defined(MFC_OpenMP)
4956# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4957
4958# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4959#endif
4960 do i = 1, 3
4961 ! Flux of rho*v_i in the y direction = rho * v_i * v_y - B_i * B_y +
4962 ! delta_(y,i) * p_tot
4963 flux_rsy_vf(j, k, l, &
4964 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
4965 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
4966 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
4967 & ) + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
4968 end do
4969 else if (mhd .and. relativity) then
4970
4971# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4972#if defined(MFC_OpenACC)
4973# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4974!$acc loop seq
4975# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4976#elif defined(MFC_OpenMP)
4977# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4978
4979# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4980#endif
4981 do i = 1, 3
4982 ! Flux of m_i in the y direction = m_i * v_y - b_i/Gamma * B_y +
4983 ! delta_(y,i) * p_tot
4984 flux_rsy_vf(j, k, l, &
4985 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
4986 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
4987 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l &
4988 & + pres_mag%L)) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
4989 end do
4990 else if (bubbles_euler) then
4991
4992# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4993#if defined(MFC_OpenACC)
4994# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4995!$acc loop seq
4996# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4997#elif defined(MFC_OpenMP)
4998# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4999
5000# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5001#endif
5002 do i = 1, num_vels
5003 flux_rsy_vf(j, k, l, &
5004 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
5005 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
5006 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
5007 & *(pres_l - ptilde_l)) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5008 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
5009 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5010 end do
5011 else if (hypoelasticity) then
5012
5013# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5014#if defined(MFC_OpenACC)
5015# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5016!$acc loop seq
5017# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5018#elif defined(MFC_OpenMP)
5019# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5020
5021# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5022#endif
5023 do i = 1, num_vels
5024 flux_rsy_vf(j, k, l, &
5025 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
5026 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
5027 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
5028 & *pres_l - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5029 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
5030 end do
5031 else
5032
5033# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5034#if defined(MFC_OpenACC)
5035# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5036!$acc loop seq
5037# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5038#elif defined(MFC_OpenMP)
5039# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5040
5041# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5042#endif
5043 do i = 1, num_vels
5044 flux_rsy_vf(j, k, l, &
5045 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
5046 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*pres_r) &
5047 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
5048 & *pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i)))) &
5049 & /(s_m - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) &
5050 & - vel_l(dir_idx(i)))
5051 end do
5052 end if
5053
5054 ! Energy
5055 if (mhd .and. (.not. relativity)) then
5056 ! energy flux = (E + p + p_mag) * v_y - B_y * (v_x*B_x + v_y*B_y + v_z*B_z)
5057# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5058 flux_rsy_vf(j, k, l, &
5059 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) &
5060 & - b%R(norm_dir)*(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
5061 & - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir) &
5062 & *(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) + s_m*s_p*(e_l &
5063 & - e_r))/(s_m - s_p)
5064# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5065 else if (mhd .and. relativity) then
5066 ! energy flux = m_y - mass flux Hard-coded for single-component for now
5067 flux_rsy_vf(j, k, l, &
5068 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
5069 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l &
5070 & - e_r))/(s_m - s_p)
5071 else if (bubbles_euler) then
5072 flux_rsy_vf(j, k, l, &
5073 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
5074 & - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m &
5075 & - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
5076 else if (hypoelasticity) then
5077 flux_tau_l = 0._wp; flux_tau_r = 0._wp
5078
5079# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5080#if defined(MFC_OpenACC)
5081# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5082!$acc loop seq
5083# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5084#elif defined(MFC_OpenMP)
5085# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5086
5087# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5088#endif
5089 do i = 1, num_dims
5090 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
5091 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
5092 end do
5093 flux_rsy_vf(j, k, l, &
5094 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
5095 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r)) &
5096 & /(s_m - s_p)
5097 else
5098 flux_rsy_vf(j, k, l, &
5099 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1)) &
5100 & *(e_l + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
5101 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
5102 end if
5103
5104 ! Elastic Stresses
5105 if (hypoelasticity) then
5106 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
5107 flux_rsy_vf(j, k, l, &
5108 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
5109 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
5110 & - rho_r*tau_e_r(i)))/(s_m - s_p)
5111 end do
5112 end if
5113
5114 ! Advection flux and source: interface velocity for volume fraction transport
5115
5116# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5117#if defined(MFC_OpenACC)
5118# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5119!$acc loop seq
5120# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5121#elif defined(MFC_OpenMP)
5122# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5123
5124# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5125#endif
5126 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5127 flux_rsy_vf(j, k, l, i) = (ql_prim_rsy_vf(j, k, l, i) - qr_prim_rsy_vf(j + 1, &
5128 & k, l, i))*s_m*s_p/(s_m - s_p)
5129 flux_src_rsy_vf(j, k, l, i) = (s_m*qr_prim_rsy_vf(j + 1, k, l, &
5130 & i) - s_p*ql_prim_rsy_vf(j, k, l, i))/(s_m - s_p)
5131 end do
5132
5133 if (bubbles_euler) then
5134 ! From HLLC: Kills mass transport @ bubble gas density
5135 if (num_fluids > 1) then
5136 flux_rsy_vf(j, k, l, eqn_idx%cont%end) = 0._wp
5137 end if
5138 end if
5139
5140 if (chemistry) then
5141
5142# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5143#if defined(MFC_OpenACC)
5144# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5145!$acc loop seq
5146# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5147#elif defined(MFC_OpenMP)
5148# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5149
5150# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5151#endif
5152 do i = eqn_idx%species%beg, eqn_idx%species%end
5153 y_l = ql_prim_rsy_vf(j, k, l, i)
5154 y_r = qr_prim_rsy_vf(j + 1, k, l, i)
5155
5156 flux_rsy_vf(j, k, l, &
5157 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
5158 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
5159 flux_src_rsy_vf(j, k, l, i) = 0._wp
5160 end do
5161 end if
5162
5163 ! MHD: magnetic flux and Maxwell stress contributions
5164 if (mhd) then
5165 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
5166 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
5167
5168# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5169#if defined(MFC_OpenACC)
5170# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5171!$acc loop seq
5172# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5173#elif defined(MFC_OpenMP)
5174# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5175
5176# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5177#endif
5178 do i = 0, 1
5179 flux_rsx_vf(j, k, l, &
5180 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
5181 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
5182 & - b%R(2 + i)))/(s_m - s_p)
5183 end do
5184 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
5185 ! B_x d/dy flux = (1 - delta(x,y)) * (v_y * B_x - v_x * B_y) B_y
5186 ! d/dy flux = (1 - delta(y,y)) * (v_y * B_y - v_y * B_y) B_z d/dy
5187 ! flux = (1 - delta(z,y)) * (v_y * B_z - v_z * B_y)
5188
5189# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5190#if defined(MFC_OpenACC)
5191# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5192!$acc loop seq
5193# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5194#elif defined(MFC_OpenMP)
5195# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5196
5197# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5198#endif
5199 do i = 0, 2
5200 flux_rsy_vf(j, k, l, &
5201 & eqn_idx%B%beg + i) = (1 - dir_flg(i + 1))*(s_m*(vel_r(dir_idx(1)) &
5202 & *b%R(i + 1) - vel_r(i + 1)*b%R(norm_dir)) - s_p*(vel_l(dir_idx(1)) &
5203 & *b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) &
5204 & - b%R(i + 1)))/(s_m - s_p)
5205 end do
5206 end if
5207 flux_src_rsy_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
5208 end if
5209
5210# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5211 if (cyl_coord) then
5212 ! Substituting the advective flux into the inviscid geometrical source flux
5213
5214# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5215#if defined(MFC_OpenACC)
5216# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5217!$acc loop seq
5218# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5219#elif defined(MFC_OpenMP)
5220# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5221
5222# 1378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5223#endif
5224 do i = 1, eqn_idx%E
5225 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
5226 end do
5227 ! Recalculating the radial momentum geometric source flux
5228 flux_gsrc_rsy_vf(j, k, l, eqn_idx%cont%end + 2) = flux_rsy_vf(j, k, l, &
5229 & eqn_idx%cont%end + 2) - (s_m*pres_r - s_p*pres_l)/(s_m - s_p)
5230 ! Geometrical source of the void fraction(s) is zero
5231
5232# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5233#if defined(MFC_OpenACC)
5234# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5235!$acc loop seq
5236# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5237#elif defined(MFC_OpenMP)
5238# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5239
5240# 1386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5241#endif
5242 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5243 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
5244 end do
5245 end if
5246
5247 if (cyl_coord .and. hypoelasticity) then
5248 ! += tau_sigmasigma using HLL
5249 flux_gsrc_rsy_vf(j, k, l, eqn_idx%cont%end + 2) = flux_gsrc_rsy_vf(j, k, l, &
5250 & eqn_idx%cont%end + 2) + (s_m*tau_e_r(4) - s_p*tau_e_l(4))/(s_m - s_p)
5251
5252
5253# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5254#if defined(MFC_OpenACC)
5255# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5256!$acc loop seq
5257# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5258#elif defined(MFC_OpenMP)
5259# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5260
5261# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5262#endif
5263 do i = eqn_idx%stress%beg, eqn_idx%stress%end
5264 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
5265 end do
5266 end if
5267# 1403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5268 end do
5269 end do
5270 end do
5271
5272# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5273#if defined(MFC_OpenACC)
5274# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5275!$acc end parallel loop
5276# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5277#elif defined(MFC_OpenMP)
5278# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5279
5280# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5281!$omp end target teams loop
5282# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5283#endif
5284 end if
5285# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5286 if (norm_dir == 3) then
5287
5288# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5289
5290# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5291#if defined(MFC_OpenACC)
5292# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5293!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, Ys_L, Ys_R, xi_field_L, xi_field_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, c_fast, pres_mag, B, Ga, vdotB, B2, b4, cm, pcorr, zcoef, vel_grad_L, vel_grad_R, idx_right_phys, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, c_avg, pres_L, pres_R, rho_L, rho_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, c_L, c_R, E_L, E_R, H_L, H_R, ptilde_L, ptilde_R, s_M, s_P, xi_M, xi_P, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, Cp_L, Cp_R, Cv_L, Cv_R, R_gas_L, R_gas_R, MW_L, MW_R, T_L, T_R, Y_L, Y_R)
5294# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5295#elif defined(MFC_OpenMP)
5296# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5297
5298# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5299
5300# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5301
5302# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5303!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, tau_e_L, tau_e_R, G_L, G_R, Re_L, Re_R, rho_avg, h_avg, gamma_avg, s_L, s_R, s_S, Ys_L, Ys_R, xi_field_L, xi_field_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, c_fast, pres_mag, B, Ga, vdotB, B2, b4, cm, pcorr, zcoef, vel_grad_L, vel_grad_R, idx_right_phys, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, c_avg, pres_L, pres_R, rho_L, rho_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, c_L, c_R, E_L, E_R, H_L, H_R, ptilde_L, ptilde_R, s_M, s_P, xi_M, xi_P, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, Cp_L, Cp_R, Cv_L, Cv_R, R_gas_L, R_gas_R, MW_L, MW_R, T_L, T_R, Y_L, Y_R)
5304# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5305#endif
5306# 924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5307 do l = is3%beg, is3%end
5308 do k = is2%beg, is2%end
5309 do j = is1%beg, is1%end
5310
5311# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5312#if defined(MFC_OpenACC)
5313# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5314!$acc loop seq
5315# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5316#elif defined(MFC_OpenMP)
5317# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5318
5319# 927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5320#endif
5321 do i = 1, eqn_idx%cont%end
5322 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
5323 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
5324 end do
5325
5326 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5327
5328
5329# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5330#if defined(MFC_OpenACC)
5331# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5332!$acc loop seq
5333# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5334#elif defined(MFC_OpenMP)
5335# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5336
5337# 935 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5338#endif
5339 do i = 1, num_vels
5340 vel_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%cont%end + i)
5341 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%cont%end + i)
5342 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5343 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5344 end do
5345
5346
5347# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5348#if defined(MFC_OpenACC)
5349# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5350!$acc loop seq
5351# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5352#elif defined(MFC_OpenMP)
5353# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5354
5355# 943 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5356#endif
5357 do i = 1, num_fluids
5358 alpha_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)
5359 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)
5360 end do
5361
5362 pres_l = ql_prim_rsz_vf(j, k, l, eqn_idx%E)
5363 pres_r = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E)
5364
5365 if (mhd) then
5366 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
5367 b%L(1) = bx0
5368 b%R(1) = bx0
5369 b%L(2) = ql_prim_rsz_vf(j, k, l, eqn_idx%B%beg)
5370 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%B%beg)
5371 b%L(3) = ql_prim_rsz_vf(j, k, l, eqn_idx%B%beg + 1)
5372 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%B%beg + 1)
5373 else ! 2D/3D: Bx, By, Bz as variables
5374 b%L(1) = ql_prim_rsz_vf(j, k, l, eqn_idx%B%beg)
5375 b%R(1) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%B%beg)
5376 b%L(2) = ql_prim_rsz_vf(j, k, l, eqn_idx%B%beg + 1)
5377 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%B%beg + 1)
5378 b%L(3) = ql_prim_rsz_vf(j, k, l, eqn_idx%B%beg + 2)
5379 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%B%beg + 2)
5380 end if
5381 end if
5382
5383 rho_l = 0._wp
5384 gamma_l = 0._wp
5385 pi_inf_l = 0._wp
5386 qv_l = 0._wp
5387
5388 rho_r = 0._wp
5389 gamma_r = 0._wp
5390 pi_inf_r = 0._wp
5391 qv_r = 0._wp
5392
5393 alpha_l_sum = 0._wp
5394 alpha_r_sum = 0._wp
5395
5396 pres_mag%L = 0._wp
5397 pres_mag%R = 0._wp
5398
5399 if (mpp_lim) then
5400
5401# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5402#if defined(MFC_OpenACC)
5403# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5404!$acc loop seq
5405# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5406#elif defined(MFC_OpenMP)
5407# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5408
5409# 987 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5410#endif
5411 do i = 1, num_fluids
5412 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
5413 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
5414 alpha_l_sum = alpha_l_sum + alpha_l(i)
5415 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
5416 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
5417 alpha_r_sum = alpha_r_sum + alpha_r(i)
5418 end do
5419
5420 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
5421 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
5422 end if
5423
5424
5425# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5426#if defined(MFC_OpenACC)
5427# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5428!$acc loop seq
5429# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5430#elif defined(MFC_OpenMP)
5431# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5432
5433# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5434#endif
5435 do i = 1, num_fluids
5436 rho_l = rho_l + alpha_rho_l(i)
5437 gamma_l = gamma_l + alpha_l(i)*gammas(i)
5438 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
5439 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
5440
5441 rho_r = rho_r + alpha_rho_r(i)
5442 gamma_r = gamma_r + alpha_r(i)*gammas(i)
5443 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
5444 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
5445 end do
5446
5447 if (viscous) then
5448
5449# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5450#if defined(MFC_OpenACC)
5451# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5452!$acc loop seq
5453# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5454#elif defined(MFC_OpenMP)
5455# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5456
5457# 1015 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5458#endif
5459 do i = 1, 2
5460 re_l(i) = dflt_real
5461 re_r(i) = dflt_real
5462
5463 if (re_size(i) > 0) re_l(i) = 0._wp
5464 if (re_size(i) > 0) re_r(i) = 0._wp
5465
5466
5467# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5468#if defined(MFC_OpenACC)
5469# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5470!$acc loop seq
5471# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5472#elif defined(MFC_OpenMP)
5473# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5474
5475# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5476#endif
5477 do q = 1, re_size(i)
5478 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
5479 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
5480 end do
5481
5482 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
5483 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
5484 end do
5485 end if
5486
5487 if (chemistry) then
5488
5489# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5490#if defined(MFC_OpenACC)
5491# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5492!$acc loop seq
5493# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5494#elif defined(MFC_OpenMP)
5495# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5496
5497# 1035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5498#endif
5499 do i = eqn_idx%species%beg, eqn_idx%species%end
5500 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsz_vf(j, k, l, i)
5501 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsz_vf(j + 1, k, l, i)
5502 end do
5503
5504 call get_mixture_molecular_weight(ys_l, mw_l)
5505 call get_mixture_molecular_weight(ys_r, mw_r)
5506
5507# 1048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5508 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
5509 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
5510# 1051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5511
5512 r_gas_l = gas_constant/mw_l
5513 r_gas_r = gas_constant/mw_r
5514 t_l = pres_l/rho_l/r_gas_l
5515 t_r = pres_r/rho_r/r_gas_r
5516
5517 call get_species_specific_heats_r(t_l, cp_il)
5518 call get_species_specific_heats_r(t_r, cp_ir)
5519
5520 if (chem_params%gamma_method == 1) then
5521 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
5522 gamma_il = cp_il/(cp_il - 1.0_wp)
5523 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
5524
5525 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
5526 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
5527 else if (chem_params%gamma_method == 2) then
5528 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
5529 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
5530 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
5531 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
5532 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
5533
5534 gamm_l = cp_l/cv_l
5535 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
5536 gamm_r = cp_r/cv_r
5537 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
5538 end if
5539
5540 call get_mixture_energy_mass(t_l, ys_l, e_l)
5541 call get_mixture_energy_mass(t_r, ys_r, e_r)
5542
5543 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
5544 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
5545 h_l = (e_l + pres_l)/rho_l
5546 h_r = (e_r + pres_r)/rho_r
5547 else if (mhd .and. relativity) then
5548# 1089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5549 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
5550 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
5551 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
5552 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
5553
5554 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
5555 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
5556 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
5557 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
5558
5559 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
5560 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
5561
5562 ! Hard-coded EOS
5563 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
5564 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
5565
5566 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
5567 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
5568
5569 e_l = rho_l*h_l*ga%L**2 - pres_l + 0.5_wp*(b2%L + vel_l_rms*b2%L - vdotb%L**2._wp) - rho_l*ga%L
5570 e_r = rho_r*h_r*ga%R**2 - pres_r + 0.5_wp*(b2%R + vel_r_rms*b2%R - vdotb%R**2._wp) - rho_r*ga%R
5571# 1112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5572 else if (mhd .and. .not. relativity) then
5573 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
5574 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
5575 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
5576 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r &
5577 & + pres_mag%R ! includes magnetic energy
5578 h_l = (e_l + pres_l - pres_mag%L)/rho_l
5579 h_r = (e_r + pres_r - pres_mag%R) &
5580 & /rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
5581 else
5582 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
5583 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
5584 h_l = (e_l + pres_l)/rho_l
5585 h_r = (e_r + pres_r)/rho_r
5586 end if
5587
5588 ! elastic energy update
5589 if (hypoelasticity) then
5590 g_l = 0._wp; g_r = 0._wp
5591
5592
5593# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5594#if defined(MFC_OpenACC)
5595# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5596!$acc loop seq
5597# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5598#elif defined(MFC_OpenMP)
5599# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5600
5601# 1132 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5602#endif
5603 do i = 1, num_fluids
5604 g_l = g_l + alpha_l(i)*gs_rs(i)
5605 g_r = g_r + alpha_r(i)*gs_rs(i)
5606 end do
5607
5608 if (cont_damage) then
5609 g_l = g_l*max((1._wp - ql_prim_rsz_vf(j, k, l, eqn_idx%damage)), 0._wp)
5610 g_r = g_r*max((1._wp - qr_prim_rsz_vf(j, k, l, eqn_idx%damage)), 0._wp)
5611 end if
5612
5613 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
5614 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
5615 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
5616 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
5617 if ((g_l > 1000) .and. (g_r > 1000)) then
5618 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5619 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5620 ! Double for shear stresses
5621 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
5622 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5623 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5624 end if
5625 end if
5626 end do
5627 end if
5628
5629 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, c_l, &
5630 & qv_l)
5631
5632 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, c_r, &
5633 & qv_r)
5634
5635 if (mhd) then
5636 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
5637 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
5638 end if
5639
5640 s_l = 0._wp; s_r = 0._wp
5641
5642
5643# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5644#if defined(MFC_OpenACC)
5645# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5646!$acc loop seq
5647# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5648#elif defined(MFC_OpenMP)
5649# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5650
5651# 1172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5652#endif
5653 do i = 1, num_dims
5654 s_l = s_l + vel_l(i)**2._wp
5655 s_r = s_r + vel_r(i)**2._wp
5656 end do
5657
5658 s_l = sqrt(s_l)
5659 s_r = sqrt(s_r)
5660
5661 s_p = max(s_l, s_r) + max(c_l, c_r)
5662 s_m = -s_p
5663
5664 s_l = s_m
5665 s_r = s_p
5666
5667 ! Low Mach correction
5668 if (low_mach == 1) then
5669 if (riemann_solver == 1 .or. riemann_solver == 5) then
5670# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5671 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5672# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5673 pcorr = 0._wp
5674# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5675
5676# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5677 if (low_mach == 1) then
5678# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5679 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5680# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5681 end if
5682# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5683 else if (riemann_solver == 2) then
5684# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5685 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5686# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5687 pcorr = 0._wp
5688# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5689
5690# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5691 if (low_mach == 1) then
5692# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5693 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
5694# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5695 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5696# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5697 else if (low_mach == 2) then
5698# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5699 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
5700# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5701 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
5702# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5703 vel_l(dir_idx(1)) = vel_l_tmp
5704# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5705 vel_r(dir_idx(1)) = vel_r_tmp
5706# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5707 end if
5708# 1189 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5709 end if
5710 else
5711 pcorr = 0._wp
5712 end if
5713
5714 ! Mass
5715 if (.not. relativity) then
5716
5717# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5718#if defined(MFC_OpenACC)
5719# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5720!$acc loop seq
5721# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5722#elif defined(MFC_OpenMP)
5723# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5724
5725# 1196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5726#endif
5727 do i = 1, eqn_idx%cont%end
5728 flux_rsz_vf(j, k, l, &
5729 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i) &
5730 & *vel_l(norm_dir) + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
5731 end do
5732 else if (relativity) then
5733
5734# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5735#if defined(MFC_OpenACC)
5736# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5737!$acc loop seq
5738# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5739#elif defined(MFC_OpenMP)
5740# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5741
5742# 1203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5743#endif
5744 do i = 1, eqn_idx%cont%end
5745 flux_rsz_vf(j, k, l, &
5746 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
5747 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i))) &
5748 & /(s_m - s_p)
5749 end do
5750 end if
5751
5752 ! Momentum
5753 if (mhd .and. (.not. relativity)) then
5754
5755# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5756#if defined(MFC_OpenACC)
5757# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5758!$acc loop seq
5759# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5760#elif defined(MFC_OpenMP)
5761# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5762
5763# 1214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5764#endif
5765 do i = 1, 3
5766 ! Flux of rho*v_i in the z direction = rho * v_i * v_z - B_i * B_z +
5767 ! delta_(z,i) * p_tot
5768 flux_rsz_vf(j, k, l, &
5769 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
5770 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
5771 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
5772 & ) + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
5773 end do
5774 else if (mhd .and. relativity) then
5775
5776# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5777#if defined(MFC_OpenACC)
5778# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5779!$acc loop seq
5780# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5781#elif defined(MFC_OpenMP)
5782# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5783
5784# 1225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5785#endif
5786 do i = 1, 3
5787 ! Flux of m_i in the z direction = m_i * v_z - b_i/Gamma * B_z +
5788 ! delta_(z,i) * p_tot
5789 flux_rsz_vf(j, k, l, &
5790 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
5791 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
5792 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l &
5793 & + pres_mag%L)) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
5794 end do
5795 else if (bubbles_euler) then
5796
5797# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5798#if defined(MFC_OpenACC)
5799# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5800!$acc loop seq
5801# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5802#elif defined(MFC_OpenMP)
5803# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5804
5805# 1236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5806#endif
5807 do i = 1, num_vels
5808 flux_rsz_vf(j, k, l, &
5809 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
5810 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
5811 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
5812 & *(pres_l - ptilde_l)) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5813 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
5814 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5815 end do
5816 else if (hypoelasticity) then
5817
5818# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5819#if defined(MFC_OpenACC)
5820# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5821!$acc loop seq
5822# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5823#elif defined(MFC_OpenMP)
5824# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5825
5826# 1247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5827#endif
5828 do i = 1, num_vels
5829 flux_rsz_vf(j, k, l, &
5830 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
5831 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
5832 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
5833 & *pres_l - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5834 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
5835 end do
5836 else
5837
5838# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5839#if defined(MFC_OpenACC)
5840# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5841!$acc loop seq
5842# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5843#elif defined(MFC_OpenMP)
5844# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5845
5846# 1257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5847#endif
5848 do i = 1, num_vels
5849 flux_rsz_vf(j, k, l, &
5850 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1)) &
5851 & *vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*pres_r) &
5852 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
5853 & *pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i)))) &
5854 & /(s_m - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) &
5855 & - vel_l(dir_idx(i)))
5856 end do
5857 end if
5858
5859 ! Energy
5860 if (mhd .and. (.not. relativity)) then
5861 ! energy flux = (E + p + p_mag) * v_z - B_z * (v_x*B_x + v_y*B_y + v_z*B_z)
5862# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5863 flux_rsz_vf(j, k, l, &
5864 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) &
5865 & - b%R(norm_dir)*(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
5866 & - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir) &
5867 & *(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) + s_m*s_p*(e_l &
5868 & - e_r))/(s_m - s_p)
5869# 1280 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5870 else if (mhd .and. relativity) then
5871 ! energy flux = m_z - mass flux Hard-coded for single-component for now
5872 flux_rsz_vf(j, k, l, &
5873 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
5874 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l &
5875 & - e_r))/(s_m - s_p)
5876 else if (bubbles_euler) then
5877 flux_rsz_vf(j, k, l, &
5878 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
5879 & - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m &
5880 & - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
5881 else if (hypoelasticity) then
5882 flux_tau_l = 0._wp; flux_tau_r = 0._wp
5883
5884# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5885#if defined(MFC_OpenACC)
5886# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5887!$acc loop seq
5888# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5889#elif defined(MFC_OpenMP)
5890# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5891
5892# 1293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5893#endif
5894 do i = 1, num_dims
5895 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
5896 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
5897 end do
5898 flux_rsz_vf(j, k, l, &
5899 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
5900 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r)) &
5901 & /(s_m - s_p)
5902 else
5903 flux_rsz_vf(j, k, l, &
5904 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1)) &
5905 & *(e_l + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
5906 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
5907 end if
5908
5909 ! Elastic Stresses
5910 if (hypoelasticity) then
5911 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
5912 flux_rsz_vf(j, k, l, &
5913 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
5914 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
5915 & - rho_r*tau_e_r(i)))/(s_m - s_p)
5916 end do
5917 end if
5918
5919 ! Advection flux and source: interface velocity for volume fraction transport
5920
5921# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5922#if defined(MFC_OpenACC)
5923# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5924!$acc loop seq
5925# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5926#elif defined(MFC_OpenMP)
5927# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5928
5929# 1320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5930#endif
5931 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5932 flux_rsz_vf(j, k, l, i) = (ql_prim_rsz_vf(j, k, l, i) - qr_prim_rsz_vf(j + 1, &
5933 & k, l, i))*s_m*s_p/(s_m - s_p)
5934 flux_src_rsz_vf(j, k, l, i) = (s_m*qr_prim_rsz_vf(j + 1, k, l, &
5935 & i) - s_p*ql_prim_rsz_vf(j, k, l, i))/(s_m - s_p)
5936 end do
5937
5938 if (bubbles_euler) then
5939 ! From HLLC: Kills mass transport @ bubble gas density
5940 if (num_fluids > 1) then
5941 flux_rsz_vf(j, k, l, eqn_idx%cont%end) = 0._wp
5942 end if
5943 end if
5944
5945 if (chemistry) then
5946
5947# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5948#if defined(MFC_OpenACC)
5949# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5950!$acc loop seq
5951# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5952#elif defined(MFC_OpenMP)
5953# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5954
5955# 1336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5956#endif
5957 do i = eqn_idx%species%beg, eqn_idx%species%end
5958 y_l = ql_prim_rsz_vf(j, k, l, i)
5959 y_r = qr_prim_rsz_vf(j + 1, k, l, i)
5960
5961 flux_rsz_vf(j, k, l, &
5962 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
5963 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
5964 flux_src_rsz_vf(j, k, l, i) = 0._wp
5965 end do
5966 end if
5967
5968 ! MHD: magnetic flux and Maxwell stress contributions
5969 if (mhd) then
5970 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
5971 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
5972
5973# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5974#if defined(MFC_OpenACC)
5975# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5976!$acc loop seq
5977# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5978#elif defined(MFC_OpenMP)
5979# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5980
5981# 1352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5982#endif
5983 do i = 0, 1
5984 flux_rsx_vf(j, k, l, &
5985 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
5986 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
5987 & - b%R(2 + i)))/(s_m - s_p)
5988 end do
5989 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
5990 ! B_x d/dz flux = (1 - delta(x,z)) * (v_z * B_x - v_x * B_z) B_y
5991 ! d/dz flux = (1 - delta(y,z)) * (v_z * B_y - v_y * B_z) B_z d/dz
5992 ! flux = (1 - delta(z,z)) * (v_z * B_z - v_z * B_z)
5993
5994# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5995#if defined(MFC_OpenACC)
5996# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5997!$acc loop seq
5998# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5999#elif defined(MFC_OpenMP)
6000# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6001
6002# 1363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6003#endif
6004 do i = 0, 2
6005 flux_rsz_vf(j, k, l, &
6006 & eqn_idx%B%beg + i) = (1 - dir_flg(i + 1))*(s_m*(vel_r(dir_idx(1)) &
6007 & *b%R(i + 1) - vel_r(i + 1)*b%R(norm_dir)) - s_p*(vel_l(dir_idx(1)) &
6008 & *b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) &
6009 & - b%R(i + 1)))/(s_m - s_p)
6010 end do
6011 end if
6012 flux_src_rsz_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
6013 end if
6014
6015# 1403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6016 end do
6017 end do
6018 end do
6019
6020# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6021#if defined(MFC_OpenACC)
6022# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6023!$acc end parallel loop
6024# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6025#elif defined(MFC_OpenMP)
6026# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6027
6028# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6029!$omp end target teams loop
6030# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6031#endif
6032 end if
6033# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6034
6035 if (viscous .or. dummy) then
6036
6037# 1411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6038
6039# 1411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6040#if defined(MFC_OpenACC)
6041# 1411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6042!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, idx_right_phys, vel_grad_L, vel_grad_R, alpha_L, alpha_R, vel_L, vel_R, Re_L, Re_R) copyin(norm_dir)
6043# 1411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6044#elif defined(MFC_OpenMP)
6045# 1411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6046
6047# 1411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6048
6049# 1411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6050
6051# 1411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6052!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, idx_right_phys, vel_grad_L, vel_grad_R, alpha_L, alpha_R, vel_L, vel_R, Re_L, Re_R) map(to:norm_dir)
6053# 1411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6054#endif
6055# 1413 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6056 do l = isz%beg, isz%end
6057 do k = isy%beg, isy%end
6058 do j = isx%beg, isx%end
6059 idx_right_phys(1) = j
6060 idx_right_phys(2) = k
6061 idx_right_phys(3) = l
6062 idx_right_phys(norm_dir) = idx_right_phys(norm_dir) + 1
6063
6064 if (norm_dir == 1) then
6065
6066# 1422 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6067#if defined(MFC_OpenACC)
6068# 1422 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6069!$acc loop seq
6070# 1422 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6071#elif defined(MFC_OpenMP)
6072# 1422 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6073
6074# 1422 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6075#endif
6076 do i = 1, num_fluids
6077 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6078 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
6079 end do
6080
6081
6082# 1428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6083#if defined(MFC_OpenACC)
6084# 1428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6085!$acc loop seq
6086# 1428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6087#elif defined(MFC_OpenMP)
6088# 1428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6089
6090# 1428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6091#endif
6092 do i = 1, num_dims
6093 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%mom%beg + i - 1)
6094 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%mom%beg + i - 1)
6095 end do
6096 else if (norm_dir == 2) then
6097
6098# 1434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6099#if defined(MFC_OpenACC)
6100# 1434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6101!$acc loop seq
6102# 1434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6103#elif defined(MFC_OpenMP)
6104# 1434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6105
6106# 1434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6107#endif
6108 do i = 1, num_fluids
6109 alpha_l(i) = ql_prim_rsy_vf(k, j, l, eqn_idx%E + i)
6110 alpha_r(i) = qr_prim_rsy_vf(k + 1, j, l, eqn_idx%E + i)
6111 end do
6112
6113# 1439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6114#if defined(MFC_OpenACC)
6115# 1439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6116!$acc loop seq
6117# 1439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6118#elif defined(MFC_OpenMP)
6119# 1439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6120
6121# 1439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6122#endif
6123 do i = 1, num_dims
6124 vel_l(i) = ql_prim_rsy_vf(k, j, l, eqn_idx%mom%beg + i - 1)
6125 vel_r(i) = qr_prim_rsy_vf(k + 1, j, l, eqn_idx%mom%beg + i - 1)
6126 end do
6127 else
6128
6129# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6130#if defined(MFC_OpenACC)
6131# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6132!$acc loop seq
6133# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6134#elif defined(MFC_OpenMP)
6135# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6136
6137# 1445 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6138#endif
6139 do i = 1, num_fluids
6140 alpha_l(i) = ql_prim_rsz_vf(l, k, j, eqn_idx%E + i)
6141 alpha_r(i) = qr_prim_rsz_vf(l + 1, k, j, eqn_idx%E + i)
6142 end do
6143
6144
6145# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6146#if defined(MFC_OpenACC)
6147# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6148!$acc loop seq
6149# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6150#elif defined(MFC_OpenMP)
6151# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6152
6153# 1451 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6154#endif
6155 do i = 1, num_dims
6156 vel_l(i) = ql_prim_rsz_vf(l, k, j, eqn_idx%mom%beg + i - 1)
6157 vel_r(i) = qr_prim_rsz_vf(l + 1, k, j, eqn_idx%mom%beg + i - 1)
6158 end do
6159 end if
6160
6161
6162# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6163#if defined(MFC_OpenACC)
6164# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6165!$acc loop seq
6166# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6167#elif defined(MFC_OpenMP)
6168# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6169
6170# 1458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6171#endif
6172 do i = 1, 2
6173 re_l(i) = dflt_real
6174 re_r(i) = dflt_real
6175
6176 if (re_size(i) > 0) re_l(i) = 0._wp
6177 if (re_size(i) > 0) re_r(i) = 0._wp
6178
6179
6180# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6181#if defined(MFC_OpenACC)
6182# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6183!$acc loop seq
6184# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6185#elif defined(MFC_OpenMP)
6186# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6187
6188# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6189#endif
6190 do q = 1, re_size(i)
6191 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
6192 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
6193 end do
6194
6195 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6196 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6197 end do
6198
6199 if (shear_stress) then
6200
6201# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6202#if defined(MFC_OpenACC)
6203# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6204!$acc loop seq
6205# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6206#elif defined(MFC_OpenMP)
6207# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6208
6209# 1477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6210#endif
6211 do i = 1, num_dims
6212 vel_grad_l(i, 1) = (dql_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(1))
6213 vel_grad_r(i, 1) = (dqr_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6214 & idx_right_phys(2), idx_right_phys(3))/re_r(1))
6215# 1483 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6216 if (num_dims > 1) then
6217 vel_grad_l(i, 2) = (dql_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(1))
6218 vel_grad_r(i, 2) = (dqr_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6219 & idx_right_phys(2), idx_right_phys(3))/re_r(1))
6220 end if
6221# 1489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6222 if (num_dims > 2) then
6223 vel_grad_l(i, 3) = (dql_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(1))
6224 vel_grad_r(i, 3) = (dqr_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6225 & idx_right_phys(2), idx_right_phys(3))/re_r(1))
6226 end if
6227# 1495 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6228# 1496 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6229 end do
6230
6231 if (norm_dir == 1) then
6232 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6233 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6234 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6235 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(1) + vel_grad_r(1, 1)*vel_r(1))
6236# 1504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6237 if (num_dims > 1) then
6238 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6239 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6240 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6241 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(1) + vel_grad_r(2, &
6242 & 2)*vel_r(1))
6243
6244 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6245 & l) - 0.5_wp*(vel_grad_l(1, 2) + vel_grad_r(1, 2)) - 0.5_wp*(vel_grad_l(2, &
6246 & 1) + vel_grad_r(2, 1))
6247 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6248 & l) - 0.5_wp*(vel_grad_l(1, 2)*vel_l(2) + vel_grad_r(1, &
6249 & 2)*vel_r(2)) - 0.5_wp*(vel_grad_l(2, 1)*vel_l(2) + vel_grad_r(2, 1)*vel_r(2))
6250# 1518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6251 if (num_dims > 2) then
6252 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6253 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6254 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6255 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, &
6256 & 3)*vel_l(1) + vel_grad_r(3, 3)*vel_r(1))
6257
6258 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6259 & l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6260 & l) - 0.5_wp*(vel_grad_l(1, 3) + vel_grad_r(1, &
6261 & 3)) - 0.5_wp*(vel_grad_l(3, 1) + vel_grad_r(3, 1))
6262 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6263 & l) - 0.5_wp*(vel_grad_l(1, 3)*vel_l(3) + vel_grad_r(1, &
6264 & 3)*vel_r(3)) - 0.5_wp*(vel_grad_l(3, 1)*vel_l(3) + vel_grad_r(3, &
6265 & 1)*vel_r(3))
6266 end if
6267# 1535 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6268 end if
6269# 1537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6270 else if (norm_dir == 2) then
6271# 1539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6272 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6273 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6274 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6275 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(2) + vel_grad_r(1, 1)*vel_r(2))
6276
6277 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6278 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6279 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6280 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(2) + vel_grad_r(2, 2)*vel_r(2))
6281
6282 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6283 & l) - 0.5_wp*(vel_grad_l(1, 2) + vel_grad_r(1, 2)) - 0.5_wp*(vel_grad_l(2, &
6284 & 1) + vel_grad_r(2, 1))
6285 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6286 & l) - 0.5_wp*(vel_grad_l(1, 2)*vel_l(1) + vel_grad_r(1, &
6287 & 2)*vel_r(1)) - 0.5_wp*(vel_grad_l(2, 1)*vel_l(1) + vel_grad_r(2, 1)*vel_r(1))
6288# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6289 if (num_dims > 2) then
6290 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, &
6291 & k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6292 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6293 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3)*vel_l(2) + vel_grad_r(3, &
6294 & 3)*vel_r(2))
6295
6296 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, &
6297 & k, l) - 0.5_wp*(vel_grad_l(2, 3) + vel_grad_r(2, &
6298 & 3)) - 0.5_wp*(vel_grad_l(3, 2) + vel_grad_r(3, 2))
6299 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6300 & l) - 0.5_wp*(vel_grad_l(2, 3)*vel_l(3) + vel_grad_r(2, &
6301 & 3)*vel_r(3)) - 0.5_wp*(vel_grad_l(3, 2)*vel_l(3) + vel_grad_r(3, &
6302 & 2)*vel_r(3))
6303 end if
6304# 1572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6305# 1573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6306 else
6307# 1575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6308 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6309 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6310 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6311 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(3) + vel_grad_r(1, 1)*vel_r(3))
6312
6313 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6314 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6315 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6316 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(3) + vel_grad_r(2, 2)*vel_r(3))
6317
6318 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6319 & l) - 0.5_wp*(vel_grad_l(1, 3) + vel_grad_r(1, 3)) - 0.5_wp*(vel_grad_l(3, &
6320 & 1) + vel_grad_r(3, 1))
6321 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6322 & l) - 0.5_wp*(vel_grad_l(1, 3)*vel_l(1) + vel_grad_r(1, &
6323 & 3)*vel_r(1)) - 0.5_wp*(vel_grad_l(3, 1)*vel_l(1) + vel_grad_r(3, 1)*vel_r(1))
6324
6325 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6326 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6327 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6328 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3)*vel_l(3) + vel_grad_r(3, 3)*vel_r(3))
6329
6330 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6331 & l) - 0.5_wp*(vel_grad_l(2, 3) + vel_grad_r(2, 3)) - 0.5_wp*(vel_grad_l(3, &
6332 & 2) + vel_grad_r(3, 2))
6333 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6334 & l) - 0.5_wp*(vel_grad_l(2, 3)*vel_l(2) + vel_grad_r(2, &
6335 & 3)*vel_r(2)) - 0.5_wp*(vel_grad_l(3, 2)*vel_l(2) + vel_grad_r(3, 2)*vel_r(2))
6336# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6337 end if
6338 end if
6339
6340 if (bulk_stress) then
6341
6342# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6343#if defined(MFC_OpenACC)
6344# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6345!$acc loop seq
6346# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6347#elif defined(MFC_OpenMP)
6348# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6349
6350# 1608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6351#endif
6352 do i = 1, num_dims
6353 vel_grad_l(i, 1) = (dql_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(2))
6354 vel_grad_r(i, 1) = (dqr_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6355 & idx_right_phys(2), idx_right_phys(3))/re_r(2))
6356# 1614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6357 if (num_dims > 1) then
6358 vel_grad_l(i, 2) = (dql_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(2))
6359 vel_grad_r(i, 2) = (dqr_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6360 & idx_right_phys(2), idx_right_phys(3))/re_r(2))
6361 end if
6362# 1620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6363# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6364 if (num_dims > 2) then
6365 vel_grad_l(i, 3) = (dql_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(2))
6366 vel_grad_r(i, 3) = (dqr_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6367 & idx_right_phys(2), idx_right_phys(3))/re_r(2))
6368 end if
6369# 1627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6370 end do
6371
6372 if (norm_dir == 1) then
6373 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6374 & l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6375 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, &
6376 & 1)*vel_l(1) + vel_grad_r(1, 1)*vel_r(1))
6377# 1635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6378 if (num_dims > 1) then
6379 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6380 & l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6381 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6382 & l) - 0.5_wp*(vel_grad_l(2, 2)*vel_l(1) + vel_grad_r(2, 2)*vel_r(1))
6383
6384# 1642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6385 if (num_dims > 2) then
6386 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6387 & l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6388 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6389 & l) - 0.5_wp*(vel_grad_l(3, 3)*vel_l(1) + vel_grad_r(3, 3)*vel_r(1))
6390 end if
6391# 1649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6392 end if
6393# 1651 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6394 else if (norm_dir == 2) then
6395# 1653 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6396 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6397 & l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6398 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6399 & l) - 0.5_wp*(vel_grad_l(1, 1)*vel_l(2) + vel_grad_r(1, 1)*vel_r(2))
6400
6401 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6402 & l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6403 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6404 & l) - 0.5_wp*(vel_grad_l(2, 2)*vel_l(2) + vel_grad_r(2, 2)*vel_r(2))
6405
6406# 1664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6407 if (num_dims > 2) then
6408 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, &
6409 & k, l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6410 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6411 & l) - 0.5_wp*(vel_grad_l(3, 3)*vel_l(2) + vel_grad_r(3, 3)*vel_r(2))
6412 end if
6413# 1671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6414# 1672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6415 else
6416# 1674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6417 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6418 & l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6419 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6420 & l) - 0.5_wp*(vel_grad_l(1, 1)*vel_l(3) + vel_grad_r(1, 1)*vel_r(3))
6421
6422 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6423 & l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6424 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6425 & l) - 0.5_wp*(vel_grad_l(2, 2)*vel_l(3) + vel_grad_r(2, 2)*vel_r(3))
6426
6427 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6428 & l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6429 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6430 & l) - 0.5_wp*(vel_grad_l(3, 3)*vel_l(3) + vel_grad_r(3, 3)*vel_r(3))
6431# 1689 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6432 end if
6433 end if
6434 end do
6435 end do
6436 end do
6437
6438# 1694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6439#if defined(MFC_OpenACC)
6440# 1694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6441!$acc end parallel loop
6442# 1694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6443#elif defined(MFC_OpenMP)
6444# 1694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6445
6446# 1694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6447!$omp end target teams loop
6448# 1694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6449#endif
6450 end if
6451
6452 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
6453
6454 end subroutine s_lf_riemann_solver
6455
6456 !> HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994)
6457 subroutine s_hllc_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, &
6458
6459 & dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, &
6460 & dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
6461
6462 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, ql_prim_rsy_vf, &
6463 & qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf
6464 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
6465 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
6466 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
6467 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
6468
6469 ! Intercell fluxes
6470 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
6471 integer, intent(in) :: norm_dir
6472 type(int_bounds_info), intent(in) :: ix, iy, iz
6473
6474# 1724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6475 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
6476 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
6477 real(wp), dimension(num_dims) :: vel_l, vel_r
6478# 1728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6479
6480 real(wp) :: rho_l, rho_r
6481 real(wp) :: pres_l, pres_r
6482 real(wp) :: e_l, e_r
6483 real(wp) :: h_l, h_r
6484# 1737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6485 real(wp), dimension(num_species) :: ys_l, ys_r, xs_l, xs_r, gamma_il, gamma_ir, cp_il, cp_ir
6486 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
6487# 1740 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6488 real(wp) :: cp_avg, cv_avg, t_avg, c_sum_yi_phi, eps
6489 real(wp) :: t_l, t_r
6490 real(wp) :: mw_l, mw_r
6491 real(wp) :: r_gas_l, r_gas_r
6492 real(wp) :: cp_l, cp_r
6493 real(wp) :: cv_l, cv_r
6494 real(wp) :: gamm_l, gamm_r
6495 real(wp) :: y_l, y_r
6496 real(wp) :: gamma_l, gamma_r
6497 real(wp) :: pi_inf_l, pi_inf_r
6498 real(wp) :: qv_l, qv_r
6499 real(wp) :: c_l, c_r
6500 real(wp), dimension(2) :: re_l, re_r
6501 real(wp) :: rho_avg
6502 real(wp) :: h_avg
6503 real(wp) :: gamma_avg
6504 real(wp) :: qv_avg
6505 real(wp) :: c_avg
6506 real(wp) :: s_l, s_r, s_m, s_p, s_s
6507 real(wp) :: xi_l, xi_r !< Left and right wave speeds functions
6508 real(wp) :: xi_m, xi_p
6509 real(wp) :: xi_mp, xi_pp
6510# 1768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6511 real(wp), dimension(nb) :: r0_l, r0_r
6512 real(wp), dimension(nb) :: v0_l, v0_r
6513 real(wp), dimension(nb) :: p0_l, p0_r
6514 real(wp), dimension(nb) :: pbw_l, pbw_r
6515# 1773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6516
6517 real(wp) :: alpha_l_sum, alpha_r_sum, nbub_l, nbub_r
6518 real(wp) :: ptilde_l, ptilde_r
6519 real(wp) :: pbwr3lbar, pbwr3rbar
6520 real(wp) :: r3lbar, r3rbar
6521 real(wp) :: r3v2lbar, r3v2rbar
6522 real(wp), dimension(6) :: tau_e_l, tau_e_r
6523# 1783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6524 real(wp), dimension(num_dims) :: xi_field_l, xi_field_r
6525# 1785 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6526 real(wp) :: g_l, g_r
6527 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
6528 real(wp) :: vel_l_tmp, vel_r_tmp
6529 real(wp) :: rho_star, e_star, p_star, p_k_star, vel_k_star
6530 real(wp) :: pres_sl, pres_sr, ms_l, ms_r
6531 real(wp) :: flux_ene_e
6532 real(wp) :: zcoef, pcorr !< low Mach number correction
6533 integer :: re_max, i, j, k, l, q !< Generic loop iterators
6534 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
6535
6536 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
6537 & dql_prim_dy_vf, dql_prim_dz_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, &
6538 & dqr_prim_dz_vf, norm_dir, ix, iy, iz)
6539
6540 ! Reshaping inputted data based on dimensional splitting direction
6541
6542 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
6543
6544# 1804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6545 if (norm_dir == 1) then
6546 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
6547 if (model_eqns == 3) then
6548 ! 6-equation model (model_eqns=3): separate phasic internal energies
6549
6550# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6551
6552# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6553#if defined(MFC_OpenACC)
6554# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6555!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
6556# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6557#elif defined(MFC_OpenMP)
6558# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6559
6560# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6561
6562# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6563
6564# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6565!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
6566# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6567#endif
6568# 1818 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6569 do l = is3%beg, is3%end
6570 do k = is2%beg, is2%end
6571 do j = is1%beg, is1%end
6572 vel_l_rms = 0._wp; vel_r_rms = 0._wp
6573 rho_l = 0._wp; rho_r = 0._wp
6574 gamma_l = 0._wp; gamma_r = 0._wp
6575 pi_inf_l = 0._wp; pi_inf_r = 0._wp
6576 qv_l = 0._wp; qv_r = 0._wp
6577 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
6578
6579
6580# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6581#if defined(MFC_OpenACC)
6582# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6583!$acc loop seq
6584# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6585#elif defined(MFC_OpenMP)
6586# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6587
6588# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6589#endif
6590 do i = 1, num_dims
6591 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
6592 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
6593 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
6594 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
6595 end do
6596
6597 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
6598 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
6599
6600 rho_l = 0._wp
6601 gamma_l = 0._wp
6602 pi_inf_l = 0._wp
6603 qv_l = 0._wp
6604
6605 rho_r = 0._wp
6606 gamma_r = 0._wp
6607 pi_inf_r = 0._wp
6608 qv_r = 0._wp
6609
6610 alpha_l_sum = 0._wp
6611 alpha_r_sum = 0._wp
6612
6613 if (mpp_lim) then
6614
6615# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6616#if defined(MFC_OpenACC)
6617# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6618!$acc loop seq
6619# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6620#elif defined(MFC_OpenMP)
6621# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6622
6623# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6624#endif
6625 do i = 1, num_fluids
6626 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
6627 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, &
6628 & l, eqn_idx%E + i)), 1._wp)
6629 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6630 end do
6631
6632
6633# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6634#if defined(MFC_OpenACC)
6635# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6636!$acc loop seq
6637# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6638#elif defined(MFC_OpenMP)
6639# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6640
6641# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6642#endif
6643 do i = 1, num_fluids
6644 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
6645 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
6646 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
6647 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
6648 end do
6649
6650
6651# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6652#if defined(MFC_OpenACC)
6653# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6654!$acc loop seq
6655# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6656#elif defined(MFC_OpenMP)
6657# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6658
6659# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6660#endif
6661 do i = 1, num_fluids
6662 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
6663 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
6664 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
6665 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
6666 end do
6667 end if
6668
6669
6670# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6671#if defined(MFC_OpenACC)
6672# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6673!$acc loop seq
6674# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6675#elif defined(MFC_OpenMP)
6676# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6677
6678# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6679#endif
6680 do i = 1, num_fluids
6681 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
6682 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
6683 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
6684 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
6685
6686 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
6687 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
6688 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
6689 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
6690
6691 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
6692 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%adv%beg + i - 1)
6693 end do
6694
6695 if (viscous) then
6696
6697# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6698#if defined(MFC_OpenACC)
6699# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6700!$acc loop seq
6701# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6702#elif defined(MFC_OpenMP)
6703# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6704
6705# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6706#endif
6707 do i = 1, 2
6708 re_l(i) = dflt_real
6709 re_r(i) = dflt_real
6710 if (re_size(i) > 0) re_l(i) = 0._wp
6711 if (re_size(i) > 0) re_r(i) = 0._wp
6712
6713# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6714#if defined(MFC_OpenACC)
6715# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6716!$acc loop seq
6717# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6718#elif defined(MFC_OpenMP)
6719# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6720
6721# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6722#endif
6723 do q = 1, re_size(i)
6724 re_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
6725 re_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, &
6726 & q) + re_r(i)
6727 end do
6728 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6729 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6730 end do
6731 end if
6732
6733 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
6734 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
6735
6736 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
6737 if (hypoelasticity) then
6738
6739# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6740#if defined(MFC_OpenACC)
6741# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6742!$acc loop seq
6743# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6744#elif defined(MFC_OpenMP)
6745# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6746
6747# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6748#endif
6749 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6750 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
6751 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
6752 end do
6753 g_l = 0._wp; g_r = 0._wp
6754
6755# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6756#if defined(MFC_OpenACC)
6757# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6758!$acc loop seq
6759# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6760#elif defined(MFC_OpenMP)
6761# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6762
6763# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6764#endif
6765 do i = 1, num_fluids
6766 g_l = g_l + alpha_l(i)*gs_rs(i)
6767 g_r = g_r + alpha_r(i)*gs_rs(i)
6768 end do
6769
6770# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6771#if defined(MFC_OpenACC)
6772# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6773!$acc loop seq
6774# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6775#elif defined(MFC_OpenMP)
6776# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6777
6778# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6779#endif
6780 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6781 ! Elastic contribution to energy if G large enough
6782 if ((g_l > verysmall) .and. (g_r > verysmall)) then
6783 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6784 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6785 ! Additional terms in 2D and 3D
6786 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
6787 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6788 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6789 end if
6790 end if
6791 end do
6792 end if
6793
6794 ! Hyperelastic stress contribution: strain energy added to total energy
6795 if (hyperelasticity) then
6796
6797# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6798#if defined(MFC_OpenACC)
6799# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6800!$acc loop seq
6801# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6802#elif defined(MFC_OpenMP)
6803# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6804
6805# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6806#endif
6807 do i = 1, num_dims
6808 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
6809 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
6810 end do
6811 g_l = 0._wp; g_r = 0._wp
6812
6813# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6814#if defined(MFC_OpenACC)
6815# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6816!$acc loop seq
6817# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6818#elif defined(MFC_OpenMP)
6819# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6820
6821# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6822#endif
6823 do i = 1, num_fluids
6824 ! Mixture left and right shear modulus
6825 g_l = g_l + alpha_l(i)*gs_rs(i)
6826 g_r = g_r + alpha_r(i)*gs_rs(i)
6827 end do
6828 ! Elastic contribution to energy if G large enough
6829 if (g_l > verysmall .and. g_r > verysmall) then
6830 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
6831 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%end + 1)
6832 end if
6833
6834# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6835#if defined(MFC_OpenACC)
6836# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6837!$acc loop seq
6838# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6839#elif defined(MFC_OpenMP)
6840# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6841
6842# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6843#endif
6844 do i = 1, b_size - 1
6845 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
6846 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
6847 end do
6848 end if
6849
6850 h_l = (e_l + pres_l)/rho_l
6851 h_r = (e_r + pres_r)/rho_r
6852
6853 if (avg_state == 1) then
6854# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6855 rho_avg = sqrt(rho_l*rho_r)
6856# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6857
6858# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6859 vel_avg_rms = 0._wp
6860# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6861
6862# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6863
6864# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6865#if defined(MFC_OpenACC)
6866# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6867!$acc loop seq
6868# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6869#elif defined(MFC_OpenMP)
6870# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6871
6872# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6873#endif
6874# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6875 do i = 1, num_vels
6876# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6877 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
6878# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6879 end do
6880# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6881
6882# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6883 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
6884# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6885
6886# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6887 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
6888# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6889
6890# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6891 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
6892# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6893
6894# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6895 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
6896# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6897
6898# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6899 if (chemistry) then
6900# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6901 eps = 0.001_wp
6902# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6903 call get_species_enthalpies_rt(t_l, h_il)
6904# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6905 call get_species_enthalpies_rt(t_r, h_ir)
6906# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6907 h_il = h_il*gas_constant/molecular_weights*t_l
6908# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6909 h_ir = h_ir*gas_constant/molecular_weights*t_r
6910# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6911 call get_species_specific_heats_r(t_l, cp_il)
6912# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6913 call get_species_specific_heats_r(t_r, cp_ir)
6914# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6915
6916# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6917 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
6918# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6919 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
6920# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6921 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
6922# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6923 if (abs(t_l - t_r) < eps) then
6924# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6925 ! Case when T_L and T_R are very close
6926# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6927 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
6928# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6929 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
6930# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6931 & - gas_constant/molecular_weights(:)))
6932# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6933 else
6934# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6935 ! Normal calculation when T_L and T_R are sufficiently different
6936# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6937 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
6938# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6939 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
6940# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6941 end if
6942# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6943 gamma_avg = cp_avg/cv_avg
6944# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6945
6946# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6947 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
6948# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6949 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
6950# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6951 end if
6952# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6953 end if
6954# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6955
6956# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6957 if (avg_state == 2) then
6958# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6959 rho_avg = 5.e-1_wp*(rho_l + rho_r)
6960# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6961 vel_avg_rms = 0._wp
6962# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6963
6964# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6965#if defined(MFC_OpenACC)
6966# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6967!$acc loop seq
6968# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6969#elif defined(MFC_OpenMP)
6970# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6971
6972# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6973#endif
6974# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6975 do i = 1, num_vels
6976# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6977 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
6978# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6979 end do
6980# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6981
6982# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6983 h_avg = 5.e-1_wp*(h_l + h_r)
6984# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6985 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
6986# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6987 qv_avg = 5.e-1_wp*(qv_l + qv_r)
6988# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6989 end if
6990
6991 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
6992 & c_l, qv_l)
6993
6994 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
6995 & c_r, qv_r)
6996
6997 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
6998 ! variables are placeholders to call the subroutine.
6999 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
7000 & 0._wp, c_avg, qv_avg)
7001
7002 if (viscous) then
7003
7004# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7005#if defined(MFC_OpenACC)
7006# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7007!$acc loop seq
7008# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7009#elif defined(MFC_OpenMP)
7010# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7011
7012# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7013#endif
7014 do i = 1, 2
7015 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
7016 end do
7017 end if
7018
7019 ! Low Mach correction
7020 if (low_mach == 2) then
7021 if (riemann_solver == 1 .or. riemann_solver == 5) then
7022# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7023 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7024# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7025 pcorr = 0._wp
7026# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7027
7028# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7029 if (low_mach == 1) then
7030# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7031 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7032# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7033 end if
7034# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7035 else if (riemann_solver == 2) then
7036# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7037 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7038# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7039 pcorr = 0._wp
7040# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7041
7042# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7043 if (low_mach == 1) then
7044# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7045 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
7046# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7047 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7048# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7049 else if (low_mach == 2) then
7050# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7051 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7052# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7053 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
7054# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7055 vel_l(dir_idx(1)) = vel_l_tmp
7056# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7057 vel_r(dir_idx(1)) = vel_r_tmp
7058# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7059 end if
7060# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7061 end if
7062 end if
7063
7064 ! COMPUTING THE DIRECT WAVE SPEEDS
7065 if (wave_speeds == 1) then
7066 if (elasticity) then
7067 ! Elastic wave speed, Rodriguez et al. JCP (2019)
7068 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1) &
7069 & ))/rho_l), &
7070 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
7071 & + tau_e_r(dir_idx_tau(1)))/rho_r))
7072 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1) &
7073 & ))/rho_r), &
7074 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
7075 & + tau_e_l(dir_idx_tau(1)))/rho_l))
7076 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
7077 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
7078 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
7079 & - vel_r(dir_idx(1))))
7080 else
7081 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7082 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7083 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7084 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
7085 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
7086 end if
7087 else if (wave_speeds == 2) then
7088 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7089
7090 pres_sr = pres_sl
7091
7092 ! Low Mach correction: Thornber et al. JCP (2008)
7093 ms_l = max(1._wp, &
7094 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
7095 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7096 ms_r = max(1._wp, &
7097 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
7098 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7099
7100 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7101 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7102
7103 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7104 end if
7105
7106 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7107 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7108
7109 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7110 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
7111 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
7112
7113 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7114 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
7115 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
7116
7117 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
7118 xi_mp = -min(0._wp, sign(1._wp, s_l))
7119 xi_pp = max(0._wp, sign(1._wp, s_r))
7120
7121 e_star = xi_m*(e_l + xi_mp*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l &
7122 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
7123 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
7124 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
7125 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
7126
7127 rho_star = xi_m*(rho_l*(xi_mp*xi_l + 1._wp - xi_mp)) + xi_p*(rho_r*(xi_pp*xi_r + 1._wp - xi_pp))
7128
7129 vel_k_star = vel_l(dir_idx(1))*(1._wp - xi_mp) + xi_mp*vel_r(dir_idx(1)) + xi_mp*xi_pp*(s_s &
7130 & - vel_r(dir_idx(1)))
7131
7132 ! Low Mach correction
7133 if (low_mach == 1) then
7134 if (riemann_solver == 1 .or. riemann_solver == 5) then
7135# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7136 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7137# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7138 pcorr = 0._wp
7139# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7140
7141# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7142 if (low_mach == 1) then
7143# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7144 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7145# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7146 end if
7147# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7148 else if (riemann_solver == 2) then
7149# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7150 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7151# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7152 pcorr = 0._wp
7153# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7154
7155# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7156 if (low_mach == 1) then
7157# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7158 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
7159# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7160 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7161# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7162 else if (low_mach == 2) then
7163# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7164 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7165# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7166 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
7167# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7168 vel_l(dir_idx(1)) = vel_l_tmp
7169# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7170 vel_r(dir_idx(1)) = vel_r_tmp
7171# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7172 end if
7173# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7174 end if
7175 else
7176 pcorr = 0._wp
7177 end if
7178
7179 ! COMPUTING FLUXES MASS FLUX.
7180
7181# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7182#if defined(MFC_OpenACC)
7183# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7184!$acc loop seq
7185# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7186#elif defined(MFC_OpenMP)
7187# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7188
7189# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7190#endif
7191 do i = 1, eqn_idx%cont%end
7192 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7193 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsx_vf(j &
7194 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7195 end do
7196
7197 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7198
7199# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7200#if defined(MFC_OpenACC)
7201# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7202!$acc loop seq
7203# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7204#elif defined(MFC_OpenMP)
7205# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7206
7207# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7208#endif
7209 do i = 1, num_dims
7210 flux_rsx_vf(j, k, l, &
7211 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
7212 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
7213 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l) &
7214 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
7215 end do
7216
7217 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
7218 flux_rsx_vf(j, k, l, eqn_idx%E) = (e_star + p_star)*vel_k_star + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
7219
7220 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
7221 if (elasticity) then
7222 flux_ene_e = 0._wp
7223
7224# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7225#if defined(MFC_OpenACC)
7226# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7227!$acc loop seq
7228# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7229#elif defined(MFC_OpenMP)
7230# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7231
7232# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7233#endif
7234 do i = 1, num_dims
7235 ! MOMENTUM ELASTIC FLUX.
7236 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
7237 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
7238 & - xi_p*tau_e_r(dir_idx_tau(i))
7239 ! ENERGY ELASTIC FLUX.
7240 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
7241 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
7242 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
7243 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
7244 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
7245 end do
7246 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
7247 end if
7248
7249 ! VOLUME FRACTION FLUX.
7250
7251# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7252#if defined(MFC_OpenACC)
7253# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7254!$acc loop seq
7255# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7256#elif defined(MFC_OpenMP)
7257# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7258
7259# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7260#endif
7261 do i = eqn_idx%adv%beg, eqn_idx%adv%end
7262 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7263 & i)*s_s + xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*s_s
7264 end do
7265
7266 ! Advection velocity source: interface velocity for volume fraction transport
7267
7268# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7269#if defined(MFC_OpenACC)
7270# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7271!$acc loop seq
7272# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7273#elif defined(MFC_OpenMP)
7274# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7275
7276# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7277#endif
7278 do i = 1, num_dims
7279 vel_src_rsx_vf(j, k, l, &
7280 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
7281 & *(s_s*(xi_mp*(xi_l - 1) + 1) - vel_l(dir_idx(i)))) &
7282 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(s_s*(xi_pp*(xi_r - 1) &
7283 & + 1) - vel_r(dir_idx(i))))
7284 end do
7285
7286 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
7287 ! energy flux
7288
7289# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7290#if defined(MFC_OpenACC)
7291# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7292!$acc loop seq
7293# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7294#elif defined(MFC_OpenMP)
7295# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7296
7297# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7298#endif
7299 do i = 1, num_fluids
7300 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
7301 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
7302 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
7303 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
7304 & + pres_r)
7305
7306 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
7307 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7308 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
7309 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
7310 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7311 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
7312 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
7313 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7314 & i + eqn_idx%adv%beg - 1))
7315 end do
7316
7317 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7318
7319 ! HYPOELASTIC STRESS EVOLUTION FLUX.
7320 if (hypoelasticity) then
7321
7322# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7323#if defined(MFC_OpenACC)
7324# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7325!$acc loop seq
7326# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7327#elif defined(MFC_OpenMP)
7328# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7329
7330# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7331#endif
7332 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
7333 flux_rsx_vf(j, k, l, &
7334 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s)) &
7335 & *(s_l*rho_l*tau_e_l(i) - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) &
7336 & + xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*tau_e_r(i) &
7337 & - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
7338 end do
7339 end if
7340
7341 ! Hyperelastic reference map flux for material deformation tracking
7342 if (hyperelasticity) then
7343
7344# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7345#if defined(MFC_OpenACC)
7346# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7347!$acc loop seq
7348# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7349#elif defined(MFC_OpenMP)
7350# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7351
7352# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7353#endif
7354 do i = 1, num_dims
7355 flux_rsx_vf(j, k, l, &
7356 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s)) &
7357 & *(s_l*rho_l*xi_field_l(i) - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) &
7358 & + xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
7359 & - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
7360 end do
7361 end if
7362
7363 ! COLOR FUNCTION FLUX
7364 if (surface_tension) then
7365 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
7366 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c))*s_s
7367 end if
7368
7369 ! Geometrical source flux for cylindrical coordinates
7370# 2205 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7371# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7372 end do
7373 end do
7374 end do
7375
7376# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7377#if defined(MFC_OpenACC)
7378# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7379!$acc end parallel loop
7380# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7381#elif defined(MFC_OpenMP)
7382# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7383
7384# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7385!$omp end target teams loop
7386# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7387#endif
7388 else if (model_eqns == 4) then
7389 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
7390
7391# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7392
7393# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7394#if defined(MFC_OpenACC)
7395# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7396!$acc parallel loop collapse(3) gang vector default(present) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
7397# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7398#elif defined(MFC_OpenMP)
7399# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7400
7401# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7402
7403# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7404
7405# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7406!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
7407# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7408#endif
7409# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7410 do l = is3%beg, is3%end
7411 do k = is2%beg, is2%end
7412 do j = is1%beg, is1%end
7413 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7414 rho_l = 0._wp; rho_r = 0._wp
7415 gamma_l = 0._wp; gamma_r = 0._wp
7416 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7417 qv_l = 0._wp; qv_r = 0._wp
7418
7419
7420# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7421#if defined(MFC_OpenACC)
7422# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7423!$acc loop seq
7424# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7425#elif defined(MFC_OpenMP)
7426# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7427
7428# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7429#endif
7430 do i = 1, eqn_idx%cont%end
7431 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
7432 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
7433 end do
7434
7435
7436# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7437#if defined(MFC_OpenACC)
7438# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7439!$acc loop seq
7440# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7441#elif defined(MFC_OpenMP)
7442# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7443
7444# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7445#endif
7446 do i = 1, num_dims
7447 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7448 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
7449 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7450 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7451 end do
7452
7453
7454# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7455#if defined(MFC_OpenACC)
7456# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7457!$acc loop seq
7458# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7459#elif defined(MFC_OpenMP)
7460# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7461
7462# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7463#endif
7464 do i = 1, num_fluids
7465 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7466 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
7467 end do
7468
7469# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7470#if defined(MFC_OpenACC)
7471# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7472!$acc loop seq
7473# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7474#elif defined(MFC_OpenMP)
7475# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7476
7477# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7478#endif
7479 do i = 1, num_fluids
7480 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7481 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
7482 end do
7483
7484
7485# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7486#if defined(MFC_OpenACC)
7487# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7488!$acc loop seq
7489# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7490#elif defined(MFC_OpenMP)
7491# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7492
7493# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7494#endif
7495 do i = 1, num_fluids
7496 rho_l = rho_l + alpha_rho_l(i)
7497 gamma_l = gamma_l + alpha_l(i)*gammas(i)
7498 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
7499 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
7500
7501 rho_r = rho_r + alpha_rho_r(i)
7502 gamma_r = gamma_r + alpha_r(i)*gammas(i)
7503 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
7504 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
7505 end do
7506
7507 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7508 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
7509
7510 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
7511 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
7512
7513 h_l = (e_l + pres_l)/rho_l
7514 h_r = (e_r + pres_r)/rho_r
7515
7516 if (avg_state == 1) then
7517# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7518 rho_avg = sqrt(rho_l*rho_r)
7519# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7520
7521# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7522 vel_avg_rms = 0._wp
7523# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7524
7525# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7526
7527# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7528#if defined(MFC_OpenACC)
7529# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7530!$acc loop seq
7531# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7532#elif defined(MFC_OpenMP)
7533# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7534
7535# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7536#endif
7537# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7538 do i = 1, num_vels
7539# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7540 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
7541# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7542 end do
7543# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7544
7545# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7546 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
7547# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7548
7549# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7550 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
7551# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7552
7553# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7554 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
7555# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7556
7557# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7558 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
7559# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7560
7561# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7562 if (chemistry) then
7563# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7564 eps = 0.001_wp
7565# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7566 call get_species_enthalpies_rt(t_l, h_il)
7567# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7568 call get_species_enthalpies_rt(t_r, h_ir)
7569# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7570 h_il = h_il*gas_constant/molecular_weights*t_l
7571# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7572 h_ir = h_ir*gas_constant/molecular_weights*t_r
7573# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7574 call get_species_specific_heats_r(t_l, cp_il)
7575# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7576 call get_species_specific_heats_r(t_r, cp_ir)
7577# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7578
7579# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7580 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
7581# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7582 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
7583# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7584 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
7585# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7586 if (abs(t_l - t_r) < eps) then
7587# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7588 ! Case when T_L and T_R are very close
7589# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7590 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
7591# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7592 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
7593# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7594 & - gas_constant/molecular_weights(:)))
7595# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7596 else
7597# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7598 ! Normal calculation when T_L and T_R are sufficiently different
7599# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7600 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
7601# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7602 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
7603# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7604 end if
7605# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7606 gamma_avg = cp_avg/cv_avg
7607# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7608
7609# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7610 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
7611# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7612 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
7613# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7614 end if
7615# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7616 end if
7617# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7618
7619# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7620 if (avg_state == 2) then
7621# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7622 rho_avg = 5.e-1_wp*(rho_l + rho_r)
7623# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7624 vel_avg_rms = 0._wp
7625# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7626
7627# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7628#if defined(MFC_OpenACC)
7629# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7630!$acc loop seq
7631# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7632#elif defined(MFC_OpenMP)
7633# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7634
7635# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7636#endif
7637# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7638 do i = 1, num_vels
7639# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7640 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
7641# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7642 end do
7643# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7644
7645# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7646 h_avg = 5.e-1_wp*(h_l + h_r)
7647# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7648 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
7649# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7650 qv_avg = 5.e-1_wp*(qv_l + qv_r)
7651# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7652 end if
7653
7654 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
7655 & c_l, qv_l)
7656
7657 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
7658 & c_r, qv_r)
7659
7660 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
7661 ! variables are placeholders to call the subroutine.
7662
7663 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
7664 & 0._wp, c_avg, qv_avg)
7665
7666 if (wave_speeds == 1) then
7667 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7668 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7669
7670 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7671 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
7672 & - rho_r*(s_r - vel_r(dir_idx(1))))
7673 else if (wave_speeds == 2) then
7674 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7675
7676 pres_sr = pres_sl
7677
7678 ! Low Mach correction: Thornber et al. JCP (2008)
7679 ms_l = max(1._wp, &
7680 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
7681 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7682 ms_r = max(1._wp, &
7683 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
7684 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7685
7686 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7687 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7688
7689 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7690 end if
7691
7692 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7693 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7694
7695 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7696 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
7697 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
7698
7699 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7700 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
7701 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
7702
7703
7704# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7705#if defined(MFC_OpenACC)
7706# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7707!$acc loop seq
7708# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7709#elif defined(MFC_OpenMP)
7710# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7711
7712# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7713#endif
7714 do i = 1, eqn_idx%cont%end
7715 flux_rsx_vf(j, k, l, &
7716 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
7717 & + xi_p*alpha_rho_r(i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7718 end do
7719
7720 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7721
7722# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7723#if defined(MFC_OpenACC)
7724# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7725!$acc loop seq
7726# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7727#elif defined(MFC_OpenMP)
7728# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7729
7730# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7731#endif
7732 do i = 1, num_dims
7733 flux_rsx_vf(j, k, l, &
7734 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
7735 & *vel_l(dir_idx(i)) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp &
7736 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) &
7737 & + dir_flg(dir_idx(i))*pres_l) + xi_p*(rho_r*(vel_r(dir_idx(1)) &
7738 & *vel_r(dir_idx(i)) + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp &
7739 & - dir_flg(dir_idx(i)))*vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) &
7740 & + dir_flg(dir_idx(i))*pres_r)
7741 end do
7742
7743 if (bubbles_euler) then
7744 ! Put p_tilde in
7745
7746# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7747#if defined(MFC_OpenACC)
7748# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7749!$acc loop seq
7750# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7751#elif defined(MFC_OpenMP)
7752# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7753
7754# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7755#endif
7756 do i = 1, num_dims
7757 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
7758 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i)) &
7759 & *(-1._wp*ptilde_l)) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
7760 end do
7761 end if
7762
7763 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
7764
7765
7766# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7767#if defined(MFC_OpenACC)
7768# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7769!$acc loop seq
7770# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7771#elif defined(MFC_OpenMP)
7772# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7773
7774# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7775#endif
7776 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
7777 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7778 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsx_vf(j &
7779 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7780 end do
7781
7782 ! Advection velocity source: interface velocity for volume fraction transport
7783
7784# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7785#if defined(MFC_OpenACC)
7786# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7787!$acc loop seq
7788# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7789#elif defined(MFC_OpenMP)
7790# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7791
7792# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7793#endif
7794 do i = 1, num_dims
7795 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
7796 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
7797 end do
7798
7799 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7800
7801 ! Add advection flux for bubble variables
7802 if (bubbles_euler) then
7803
7804# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7805#if defined(MFC_OpenACC)
7806# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7807!$acc loop seq
7808# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7809#elif defined(MFC_OpenMP)
7810# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7811
7812# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7813#endif
7814 do i = eqn_idx%bub%beg, eqn_idx%bub%end
7815 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
7816 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
7817 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, &
7818 & i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7819 end do
7820 end if
7821
7822 ! Geometrical source flux for cylindrical coordinates
7823
7824# 2424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7825# 2441 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7826 end do
7827 end do
7828 end do
7829
7830# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7831#if defined(MFC_OpenACC)
7832# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7833!$acc end parallel loop
7834# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7835#elif defined(MFC_OpenMP)
7836# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7837
7838# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7839!$omp end target teams loop
7840# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7841#endif
7842 else if (model_eqns == 2 .and. bubbles_euler) then
7843 ! 5-equation model with Euler-Euler bubble dynamics
7844
7845# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7846
7847# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7848#if defined(MFC_OpenACC)
7849# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7850!$acc parallel loop collapse(3) gang vector default(present) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
7851# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7852#elif defined(MFC_OpenMP)
7853# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7854
7855# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7856
7857# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7858
7859# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7860!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
7861# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7862#endif
7863# 2455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7864 do l = is3%beg, is3%end
7865 do k = is2%beg, is2%end
7866 do j = is1%beg, is1%end
7867 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7868 rho_l = 0._wp; rho_r = 0._wp
7869 gamma_l = 0._wp; gamma_r = 0._wp
7870 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7871 qv_l = 0._wp; qv_r = 0._wp
7872
7873
7874# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7875#if defined(MFC_OpenACC)
7876# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7877!$acc loop seq
7878# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7879#elif defined(MFC_OpenMP)
7880# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7881
7882# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7883#endif
7884 do i = 1, num_fluids
7885 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7886 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
7887 end do
7888
7889 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7890
7891
7892# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7893#if defined(MFC_OpenACC)
7894# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7895!$acc loop seq
7896# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7897#elif defined(MFC_OpenMP)
7898# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7899
7900# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7901#endif
7902 do i = 1, num_dims
7903 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7904 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
7905 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7906 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7907 end do
7908
7909 ! Retain this in the refactor
7910 if (mpp_lim .and. (num_fluids > 2)) then
7911
7912# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7913#if defined(MFC_OpenACC)
7914# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7915!$acc loop seq
7916# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7917#elif defined(MFC_OpenMP)
7918# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7919
7920# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7921#endif
7922 do i = 1, num_fluids
7923 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7924 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
7925 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
7926 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7927 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
7928 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
7929 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
7930 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
7931 end do
7932 else if (num_fluids > 2) then
7933
7934# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7935#if defined(MFC_OpenACC)
7936# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7937!$acc loop seq
7938# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7939#elif defined(MFC_OpenMP)
7940# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7941
7942# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7943#endif
7944 do i = 1, num_fluids - 1
7945 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7946 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
7947 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
7948 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7949 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
7950 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
7951 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
7952 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
7953 end do
7954 else
7955 rho_l = ql_prim_rsx_vf(j, k, l, 1)
7956 gamma_l = gammas(1)
7957 pi_inf_l = pi_infs(1)
7958 qv_l = qvs(1)
7959 rho_r = qr_prim_rsx_vf(j + 1, k, l, 1)
7960 gamma_r = gammas(1)
7961 pi_inf_r = pi_infs(1)
7962 qv_r = qvs(1)
7963 end if
7964
7965 if (viscous) then
7966 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
7967
7968# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7969#if defined(MFC_OpenACC)
7970# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7971!$acc loop seq
7972# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7973#elif defined(MFC_OpenMP)
7974# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7975
7976# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7977#endif
7978 do i = 1, 2
7979 re_l(i) = dflt_real
7980 re_r(i) = dflt_real
7981
7982 if (re_size(i) > 0) re_l(i) = 0._wp
7983 if (re_size(i) > 0) re_r(i) = 0._wp
7984
7985
7986# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7987#if defined(MFC_OpenACC)
7988# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7989!$acc loop seq
7990# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7991#elif defined(MFC_OpenMP)
7992# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7993
7994# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7995#endif
7996 do q = 1, re_size(i)
7997 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
7998 & q)))/res_gs(i, q) + re_l(i)
7999 re_r(i) = (1._wp - qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, &
8000 & q)))/res_gs(i, q) + re_r(i)
8001 end do
8002
8003 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
8004 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
8005 end do
8006 end if
8007 end if
8008
8009 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
8010 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
8011
8012 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
8013 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
8014
8015 h_l = (e_l + pres_l)/rho_l
8016 h_r = (e_r + pres_r)/rho_r
8017
8018 if (avg_state == 2) then
8019
8020# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8021#if defined(MFC_OpenACC)
8022# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8023!$acc loop seq
8024# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8025#elif defined(MFC_OpenMP)
8026# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8027
8028# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8029#endif
8030 do i = 1, nb
8031 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
8032 r0_r(i) = qr_prim_rsx_vf(j + 1, k, l, rs(i))
8033
8034 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
8035 v0_r(i) = qr_prim_rsx_vf(j + 1, k, l, vs(i))
8036 if (.not. polytropic .and. .not. qbmm) then
8037 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
8038 p0_r(i) = qr_prim_rsx_vf(j + 1, k, l, ps(i))
8039 end if
8040 end do
8041
8042 if (.not. qbmm) then
8043 if (adv_n) then
8044 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
8045 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%n)
8046 else
8047 nbub_l = 0._wp
8048 nbub_r = 0._wp
8049
8050# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8051#if defined(MFC_OpenACC)
8052# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8053!$acc loop seq
8054# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8055#elif defined(MFC_OpenMP)
8056# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8057
8058# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8059#endif
8060 do i = 1, nb
8061 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
8062 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
8063 end do
8064
8065 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
8066 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j + 1, k, l, &
8067 & eqn_idx%E + num_fluids)/nbub_r
8068 end if
8069 else
8070 ! nb stored in 0th moment of first R0 bin in variable conversion module
8071 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
8072 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%bub%beg)
8073 end if
8074
8075
8076# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8077#if defined(MFC_OpenACC)
8078# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8079!$acc loop seq
8080# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8081#elif defined(MFC_OpenMP)
8082# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8083
8084# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8085#endif
8086 do i = 1, nb
8087 if (.not. qbmm) then
8088 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
8089 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
8090 end if
8091 end do
8092
8093 if (qbmm) then
8094 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
8095 pbwr3rbar = mom_sp_rsx_vf(j + 1, k, l, 4)
8096
8097 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
8098 r3rbar = mom_sp_rsx_vf(j + 1, k, l, 1)
8099
8100 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
8101 r3v2rbar = mom_sp_rsx_vf(j + 1, k, l, 3)
8102 else
8103 pbwr3lbar = 0._wp
8104 pbwr3rbar = 0._wp
8105
8106 r3lbar = 0._wp
8107 r3rbar = 0._wp
8108
8109 r3v2lbar = 0._wp
8110 r3v2rbar = 0._wp
8111
8112
8113# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8114#if defined(MFC_OpenACC)
8115# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8116!$acc loop seq
8117# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8118#elif defined(MFC_OpenMP)
8119# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8120
8121# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8122#endif
8123 do i = 1, nb
8124 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
8125 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
8126
8127 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
8128 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
8129
8130 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
8131 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
8132 end do
8133 end if
8134
8135 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8136 h_avg = 5.e-1_wp*(h_l + h_r)
8137 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8138 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8139 vel_avg_rms = 0._wp
8140
8141
8142# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8143#if defined(MFC_OpenACC)
8144# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8145!$acc loop seq
8146# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8147#elif defined(MFC_OpenMP)
8148# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8149
8150# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8151#endif
8152 do i = 1, num_dims
8153 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8154 end do
8155 end if
8156
8157 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
8158 & c_l, qv_l)
8159
8160 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
8161 & c_r, qv_r)
8162
8163 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8164 ! variables are placeholders to call the subroutine.
8165 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
8166 & 0._wp, c_avg, qv_avg)
8167
8168 if (viscous) then
8169
8170# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8171#if defined(MFC_OpenACC)
8172# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8173!$acc loop seq
8174# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8175#elif defined(MFC_OpenMP)
8176# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8177
8178# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8179#endif
8180 do i = 1, 2
8181 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
8182 end do
8183 end if
8184
8185 ! Low Mach correction
8186 if (low_mach == 2) then
8187 if (riemann_solver == 1 .or. riemann_solver == 5) then
8188# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8189 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8190# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8191 pcorr = 0._wp
8192# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8193
8194# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8195 if (low_mach == 1) then
8196# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8197 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8198# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8199 end if
8200# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8201 else if (riemann_solver == 2) then
8202# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8203 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8204# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8205 pcorr = 0._wp
8206# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8207
8208# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8209 if (low_mach == 1) then
8210# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8211 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
8212# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8213 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8214# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8215 else if (low_mach == 2) then
8216# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8217 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8218# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8219 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
8220# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8221 vel_l(dir_idx(1)) = vel_l_tmp
8222# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8223 vel_r(dir_idx(1)) = vel_r_tmp
8224# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8225 end if
8226# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8227 end if
8228 end if
8229
8230 if (wave_speeds == 1) then
8231 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
8232 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
8233
8234 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
8235 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
8236 & - rho_r*(s_r - vel_r(dir_idx(1))))
8237 else if (wave_speeds == 2) then
8238 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8239
8240 pres_sr = pres_sl
8241
8242 ! Low Mach correction: Thornber et al. JCP (2008)
8243 ms_l = max(1._wp, &
8244 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
8245 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
8246 ms_r = max(1._wp, &
8247 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
8248 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
8249
8250 s_l = vel_l(dir_idx(1)) - c_l*ms_l
8251 s_r = vel_r(dir_idx(1)) + c_r*ms_r
8252
8253 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
8254 end if
8255
8256 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
8257 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
8258
8259 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
8260 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
8261 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
8262
8263 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
8264 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
8265 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
8266
8267 ! Low Mach correction
8268 if (low_mach == 1) then
8269 if (riemann_solver == 1 .or. riemann_solver == 5) then
8270# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8271 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8272# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8273 pcorr = 0._wp
8274# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8275
8276# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8277 if (low_mach == 1) then
8278# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8279 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8280# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8281 end if
8282# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8283 else if (riemann_solver == 2) then
8284# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8285 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8286# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8287 pcorr = 0._wp
8288# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8289
8290# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8291 if (low_mach == 1) then
8292# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8293 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
8294# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8295 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8296# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8297 else if (low_mach == 2) then
8298# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8299 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8300# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8301 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
8302# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8303 vel_l(dir_idx(1)) = vel_l_tmp
8304# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8305 vel_r(dir_idx(1)) = vel_r_tmp
8306# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8307 end if
8308# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8309 end if
8310 else
8311 pcorr = 0._wp
8312 end if
8313
8314
8315# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8316#if defined(MFC_OpenACC)
8317# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8318!$acc loop seq
8319# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8320#elif defined(MFC_OpenMP)
8321# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8322
8323# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8324#endif
8325 do i = 1, eqn_idx%cont%end
8326 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8327 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsx_vf(j &
8328 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8329 end do
8330
8331 if (bubbles_euler .and. (num_fluids > 1)) then
8332 ! Kill mass transport @ gas density
8333 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
8334 end if
8335
8336 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
8337
8338 ! Include p_tilde
8339
8340 if (avg_state == 2) then
8341 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
8342 pres_l = pres_l - alpha_l(num_fluids)*pres_l
8343 else
8344 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
8345 end if
8346
8347 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
8348 pres_r = pres_r - alpha_r(num_fluids)*pres_r
8349 else
8350 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
8351 end if
8352 end if
8353
8354
8355# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8356#if defined(MFC_OpenACC)
8357# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8358!$acc loop seq
8359# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8360#elif defined(MFC_OpenMP)
8361# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8362
8363# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8364#endif
8365 do i = 1, num_dims
8366 flux_rsx_vf(j, k, l, &
8367 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
8368 & *vel_l(dir_idx(i)) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp &
8369 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) &
8370 & + dir_flg(dir_idx(i))*(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1)) &
8371 & *vel_r(dir_idx(i)) + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp &
8372 & - dir_flg(dir_idx(i)))*vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) &
8373 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i)) &
8374 & *pcorr
8375 end do
8376
8377 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
8378 flux_rsx_vf(j, k, l, &
8379 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
8380 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
8381 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s &
8382 & - vel_r(dir_idx(1)))*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) &
8383 & + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
8384
8385 ! Volume fraction flux
8386
8387# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8388#if defined(MFC_OpenACC)
8389# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8390!$acc loop seq
8391# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8392#elif defined(MFC_OpenMP)
8393# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8394
8395# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8396#endif
8397 do i = eqn_idx%adv%beg, eqn_idx%adv%end
8398 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8399 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsx_vf(j &
8400 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8401 end do
8402
8403 ! Advection velocity source: interface velocity for volume fraction transport
8404
8405# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8406#if defined(MFC_OpenACC)
8407# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8408!$acc loop seq
8409# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8410#elif defined(MFC_OpenMP)
8411# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8412
8413# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8414#endif
8415 do i = 1, num_dims
8416 vel_src_rsx_vf(j, k, l, &
8417 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*(xi_l &
8418 & - 1._wp)) + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*(xi_r &
8419 & - 1._wp))
8420
8421 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
8422 end do
8423
8424 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
8425
8426 ! Add advection flux for bubble variables
8427
8428# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8429#if defined(MFC_OpenACC)
8430# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8431!$acc loop seq
8432# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8433#elif defined(MFC_OpenMP)
8434# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8435
8436# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8437#endif
8438 do i = eqn_idx%bub%beg, eqn_idx%bub%end
8439 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
8440 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8441 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, &
8442 & i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8443 end do
8444
8445 if (qbmm) then
8446 flux_rsx_vf(j, k, l, &
8447 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8448 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8449 end if
8450
8451 if (adv_n) then
8452 flux_rsx_vf(j, k, l, &
8453 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8454 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8455 end if
8456
8457 ! Geometrical source flux for cylindrical coordinates
8458# 2821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8459# 2839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8460 end do
8461 end do
8462 end do
8463
8464# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8465#if defined(MFC_OpenACC)
8466# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8467!$acc end parallel loop
8468# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8469#elif defined(MFC_OpenMP)
8470# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8471
8472# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8473!$omp end target teams loop
8474# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8475#endif
8476 else
8477 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
8478
8479# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8480
8481# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8482#if defined(MFC_OpenACC)
8483# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8484!$acc parallel loop collapse(3) gang vector default(present) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) copyin(is1, is2, is3)
8485# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8486#elif defined(MFC_OpenMP)
8487# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8488
8489# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8490
8491# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8492
8493# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8494!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) map(to:is1, is2, is3)
8495# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8496#endif
8497# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8498 do l = is3%beg, is3%end
8499 do k = is2%beg, is2%end
8500 do j = is1%beg, is1%end
8501 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8502 rho_l = 0._wp; rho_r = 0._wp
8503 gamma_l = 0._wp; gamma_r = 0._wp
8504 pi_inf_l = 0._wp; pi_inf_r = 0._wp
8505 qv_l = 0._wp; qv_r = 0._wp
8506 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
8507
8508
8509# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8510#if defined(MFC_OpenACC)
8511# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8512!$acc loop seq
8513# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8514#elif defined(MFC_OpenMP)
8515# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8516
8517# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8518#endif
8519 do i = 1, num_fluids
8520 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8521 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
8522 end do
8523
8524
8525# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8526#if defined(MFC_OpenACC)
8527# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8528!$acc loop seq
8529# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8530#elif defined(MFC_OpenMP)
8531# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8532
8533# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8534#endif
8535 do i = 1, num_dims
8536 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
8537 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
8538 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
8539 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
8540 end do
8541
8542 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
8543 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
8544
8545 ! Change this by splitting it into the cases present in the bubbles_euler
8546 if (mpp_lim) then
8547
8548# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8549#if defined(MFC_OpenACC)
8550# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8551!$acc loop seq
8552# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8553#elif defined(MFC_OpenMP)
8554# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8555
8556# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8557#endif
8558 do i = 1, num_fluids
8559 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
8560 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, &
8561 & l, eqn_idx%E + i)), 1._wp)
8562 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
8563 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
8564 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
8565 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8566 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
8567 end do
8568
8569
8570# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8571#if defined(MFC_OpenACC)
8572# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8573!$acc loop seq
8574# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8575#elif defined(MFC_OpenMP)
8576# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8577
8578# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8579#endif
8580 do i = 1, num_fluids
8581 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
8582 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
8583 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
8584 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
8585 end do
8586 end if
8587
8588
8589# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8590#if defined(MFC_OpenACC)
8591# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8592!$acc loop seq
8593# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8594#elif defined(MFC_OpenMP)
8595# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8596
8597# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8598#endif
8599 do i = 1, num_fluids
8600 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
8601 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
8602 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
8603 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
8604
8605 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
8606 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
8607 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
8608 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
8609 end do
8610
8611 re_max = 0
8612 if (re_size(1) > 0) re_max = 1
8613 if (re_size(2) > 0) re_max = 2
8614
8615 if (viscous) then
8616
8617# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8618#if defined(MFC_OpenACC)
8619# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8620!$acc loop seq
8621# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8622#elif defined(MFC_OpenMP)
8623# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8624
8625# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8626#endif
8627 do i = 1, re_max
8628 re_l(i) = 0._wp
8629 re_r(i) = 0._wp
8630
8631
8632# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8633#if defined(MFC_OpenACC)
8634# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8635!$acc loop seq
8636# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8637#elif defined(MFC_OpenMP)
8638# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8639
8640# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8641#endif
8642 do q = 1, re_size(i)
8643 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
8644 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
8645 end do
8646
8647 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
8648 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
8649 end do
8650 end if
8651
8652 if (chemistry) then
8653 c_sum_yi_phi = 0.0_wp
8654
8655# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8656#if defined(MFC_OpenACC)
8657# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8658!$acc loop seq
8659# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8660#elif defined(MFC_OpenMP)
8661# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8662
8663# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8664#endif
8665 do i = eqn_idx%species%beg, eqn_idx%species%end
8666 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
8667 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
8668 end do
8669
8670 call get_mixture_molecular_weight(ys_l, mw_l)
8671 call get_mixture_molecular_weight(ys_r, mw_r)
8672
8673# 2952 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8674 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
8675 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
8676# 2955 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8677
8678 r_gas_l = gas_constant/mw_l
8679 r_gas_r = gas_constant/mw_r
8680
8681 t_l = pres_l/rho_l/r_gas_l
8682 t_r = pres_r/rho_r/r_gas_r
8683
8684 call get_species_specific_heats_r(t_l, cp_il)
8685 call get_species_specific_heats_r(t_r, cp_ir)
8686
8687 if (chem_params%gamma_method == 1) then
8688 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
8689 gamma_il = cp_il/(cp_il - 1.0_wp)
8690 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
8691
8692 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
8693 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
8694 else if (chem_params%gamma_method == 2) then
8695 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
8696 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
8697 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
8698 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
8699 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
8700
8701 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
8702 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
8703 end if
8704
8705 call get_mixture_energy_mass(t_l, ys_l, e_l)
8706 call get_mixture_energy_mass(t_r, ys_r, e_r)
8707
8708 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
8709 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
8710 h_l = (e_l + pres_l)/rho_l
8711 h_r = (e_r + pres_r)/rho_r
8712 else
8713 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
8714 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
8715
8716 h_l = (e_l + pres_l)/rho_l
8717 h_r = (e_r + pres_r)/rho_r
8718 end if
8719
8720 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
8721 if (hypoelasticity) then
8722
8723# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8724#if defined(MFC_OpenACC)
8725# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8726!$acc loop seq
8727# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8728#elif defined(MFC_OpenMP)
8729# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8730
8731# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8732#endif
8733 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
8734 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
8735 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
8736 end do
8737 g_l = 0._wp
8738 g_r = 0._wp
8739
8740# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8741#if defined(MFC_OpenACC)
8742# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8743!$acc loop seq
8744# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8745#elif defined(MFC_OpenMP)
8746# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8747
8748# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8749#endif
8750 do i = 1, num_fluids
8751 g_l = g_l + alpha_l(i)*gs_rs(i)
8752 g_r = g_r + alpha_r(i)*gs_rs(i)
8753 end do
8754
8755# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8756#if defined(MFC_OpenACC)
8757# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8758!$acc loop seq
8759# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8760#elif defined(MFC_OpenMP)
8761# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8762
8763# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8764#endif
8765 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
8766 ! Elastic contribution to energy if G large enough
8767 if ((g_l > verysmall) .and. (g_r > verysmall)) then
8768 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
8769 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
8770 ! Additional terms in 2D and 3D
8771 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
8772 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
8773 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
8774 end if
8775 end if
8776 end do
8777 end if
8778
8779 ! Hyperelastic stress contribution: strain energy added to total energy
8780 if (hyperelasticity) then
8781
8782# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8783#if defined(MFC_OpenACC)
8784# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8785!$acc loop seq
8786# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8787#elif defined(MFC_OpenMP)
8788# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8789
8790# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8791#endif
8792 do i = 1, num_dims
8793 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
8794 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
8795 end do
8796 g_l = 0._wp
8797 g_r = 0._wp
8798
8799# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8800#if defined(MFC_OpenACC)
8801# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8802!$acc loop seq
8803# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8804#elif defined(MFC_OpenMP)
8805# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8806
8807# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8808#endif
8809 do i = 1, num_fluids
8810 ! Mixture left and right shear modulus
8811 g_l = g_l + alpha_l(i)*gs_rs(i)
8812 g_r = g_r + alpha_r(i)*gs_rs(i)
8813 end do
8814 ! Elastic contribution to energy if G large enough
8815 if (g_l > verysmall .and. g_r > verysmall) then
8816 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
8817 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%end + 1)
8818 end if
8819
8820# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8821#if defined(MFC_OpenACC)
8822# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8823!$acc loop seq
8824# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8825#elif defined(MFC_OpenMP)
8826# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8827
8828# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8829#endif
8830 do i = 1, b_size - 1
8831 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
8832 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
8833 end do
8834 end if
8835
8836 h_l = (e_l + pres_l)/rho_l
8837 h_r = (e_r + pres_r)/rho_r
8838
8839 if (avg_state == 1) then
8840# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8841 rho_avg = sqrt(rho_l*rho_r)
8842# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8843
8844# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8845 vel_avg_rms = 0._wp
8846# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8847
8848# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8849
8850# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8851#if defined(MFC_OpenACC)
8852# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8853!$acc loop seq
8854# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8855#elif defined(MFC_OpenMP)
8856# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8857
8858# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8859#endif
8860# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8861 do i = 1, num_vels
8862# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8863 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
8864# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8865 end do
8866# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8867
8868# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8869 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
8870# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8871
8872# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8873 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
8874# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8875
8876# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8877 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
8878# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8879
8880# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8881 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
8882# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8883
8884# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8885 if (chemistry) then
8886# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8887 eps = 0.001_wp
8888# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8889 call get_species_enthalpies_rt(t_l, h_il)
8890# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8891 call get_species_enthalpies_rt(t_r, h_ir)
8892# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8893 h_il = h_il*gas_constant/molecular_weights*t_l
8894# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8895 h_ir = h_ir*gas_constant/molecular_weights*t_r
8896# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8897 call get_species_specific_heats_r(t_l, cp_il)
8898# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8899 call get_species_specific_heats_r(t_r, cp_ir)
8900# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8901
8902# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8903 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
8904# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8905 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
8906# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8907 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
8908# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8909 if (abs(t_l - t_r) < eps) then
8910# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8911 ! Case when T_L and T_R are very close
8912# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8913 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
8914# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8915 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
8916# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8917 & - gas_constant/molecular_weights(:)))
8918# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8919 else
8920# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8921 ! Normal calculation when T_L and T_R are sufficiently different
8922# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8923 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
8924# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8925 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
8926# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8927 end if
8928# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8929 gamma_avg = cp_avg/cv_avg
8930# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8931
8932# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8933 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
8934# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8935 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
8936# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8937 end if
8938# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8939 end if
8940# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8941
8942# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8943 if (avg_state == 2) then
8944# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8945 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8946# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8947 vel_avg_rms = 0._wp
8948# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8949
8950# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8951#if defined(MFC_OpenACC)
8952# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8953!$acc loop seq
8954# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8955#elif defined(MFC_OpenMP)
8956# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8957
8958# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8959#endif
8960# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8961 do i = 1, num_vels
8962# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8963 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8964# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8965 end do
8966# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8967
8968# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8969 h_avg = 5.e-1_wp*(h_l + h_r)
8970# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8971 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8972# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8973 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8974# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8975 end if
8976
8977 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
8978 & c_l, qv_l)
8979
8980 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
8981 & c_r, qv_r)
8982
8983 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8984 ! variables are placeholders to call the subroutine.
8985 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
8986 & c_sum_yi_phi, c_avg, qv_avg)
8987
8988 if (viscous) then
8989 if (chemistry) then
8990 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
8991 end if
8992
8993# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8994#if defined(MFC_OpenACC)
8995# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8996!$acc loop seq
8997# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8998#elif defined(MFC_OpenMP)
8999# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9000
9001# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9002#endif
9003 do i = 1, 2
9004 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
9005 end do
9006 end if
9007
9008 ! Low Mach correction
9009 if (low_mach == 2) then
9010 if (riemann_solver == 1 .or. riemann_solver == 5) then
9011# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9012 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9013# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9014 pcorr = 0._wp
9015# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9016
9017# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9018 if (low_mach == 1) then
9019# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9020 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9021# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9022 end if
9023# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9024 else if (riemann_solver == 2) then
9025# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9026 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9027# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9028 pcorr = 0._wp
9029# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9030
9031# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9032 if (low_mach == 1) then
9033# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9034 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
9035# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9036 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9037# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9038 else if (low_mach == 2) then
9039# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9040 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9041# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9042 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
9043# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9044 vel_l(dir_idx(1)) = vel_l_tmp
9045# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9046 vel_r(dir_idx(1)) = vel_r_tmp
9047# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9048 end if
9049# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9050 end if
9051 end if
9052
9053 if (wave_speeds == 1) then
9054 if (elasticity) then
9055 ! Elastic wave speed, Rodriguez et al. JCP (2019)
9056 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1) &
9057 & ))/rho_l), &
9058 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
9059 & + tau_e_r(dir_idx_tau(1)))/rho_r))
9060 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1) &
9061 & ))/rho_r), &
9062 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
9063 & + tau_e_l(dir_idx_tau(1)))/rho_l))
9064 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
9065 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
9066 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
9067 & - vel_r(dir_idx(1))))
9068 else
9069 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
9070 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
9071 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
9072 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
9073 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
9074 end if
9075 else if (wave_speeds == 2) then
9076 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9077
9078 pres_sr = pres_sl
9079
9080 ! Low Mach correction: Thornber et al. JCP (2008)
9081 ms_l = max(1._wp, &
9082 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
9083 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
9084 ms_r = max(1._wp, &
9085 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
9086 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
9087
9088 s_l = vel_l(dir_idx(1)) - c_l*ms_l
9089 s_r = vel_r(dir_idx(1)) + c_r*ms_r
9090
9091 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
9092 end if
9093
9094 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
9095 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
9096
9097 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
9098 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
9099 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
9100
9101 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
9102 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
9103 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
9104
9105 ! Low Mach correction
9106 if (low_mach == 1) then
9107 if (riemann_solver == 1 .or. riemann_solver == 5) then
9108# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9109 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9110# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9111 pcorr = 0._wp
9112# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9113
9114# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9115 if (low_mach == 1) then
9116# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9117 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9118# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9119 end if
9120# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9121 else if (riemann_solver == 2) then
9122# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9123 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9124# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9125 pcorr = 0._wp
9126# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9127
9128# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9129 if (low_mach == 1) then
9130# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9131 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
9132# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9133 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9134# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9135 else if (low_mach == 2) then
9136# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9137 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9138# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9139 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
9140# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9141 vel_l(dir_idx(1)) = vel_l_tmp
9142# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9143 vel_r(dir_idx(1)) = vel_r_tmp
9144# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9145 end if
9146# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9147 end if
9148 else
9149 pcorr = 0._wp
9150 end if
9151
9152 ! COMPUTING THE HLLC FLUXES MASS FLUX.
9153
9154# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9155#if defined(MFC_OpenACC)
9156# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9157!$acc loop seq
9158# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9159#elif defined(MFC_OpenMP)
9160# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9161
9162# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9163#endif
9164 do i = 1, eqn_idx%cont%end
9165 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9166 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsx_vf(j &
9167 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9168 end do
9169
9170 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
9171
9172# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9173#if defined(MFC_OpenACC)
9174# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9175!$acc loop seq
9176# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9177#elif defined(MFC_OpenMP)
9178# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9179
9180# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9181#endif
9182 do i = 1, num_dims
9183 flux_rsx_vf(j, k, l, &
9184 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
9185 & *vel_l(dir_idx(i)) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp &
9186 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) &
9187 & + dir_flg(dir_idx(i))*(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1)) &
9188 & *vel_r(dir_idx(i)) + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp &
9189 & - dir_flg(dir_idx(i)))*vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) &
9190 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i)) &
9191 & *pcorr
9192 end do
9193
9194 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
9195 flux_rsx_vf(j, k, l, &
9196 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
9197 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1))))) - e_l)) &
9198 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s &
9199 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r)) &
9200 & + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
9201
9202 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
9203 if (elasticity) then
9204 flux_ene_e = 0._wp
9205
9206# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9207#if defined(MFC_OpenACC)
9208# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9209!$acc loop seq
9210# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9211#elif defined(MFC_OpenMP)
9212# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9213
9214# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9215#endif
9216 do i = 1, num_dims
9217 ! MOMENTUM ELASTIC FLUX.
9218 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
9219 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
9220 & - xi_p*tau_e_r(dir_idx_tau(i))
9221 ! ENERGY ELASTIC FLUX.
9222 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
9223 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
9224 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
9225 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
9226 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
9227 end do
9228 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
9229 end if
9230
9231 ! HYPOELASTIC STRESS EVOLUTION FLUX.
9232 if (hypoelasticity) then
9233
9234# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9235#if defined(MFC_OpenACC)
9236# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9237!$acc loop seq
9238# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9239#elif defined(MFC_OpenMP)
9240# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9241
9242# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9243#endif
9244 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
9245 flux_rsx_vf(j, k, l, &
9246 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s)) &
9247 & *(s_l*rho_l*tau_e_l(i) - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) &
9248 & + xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*tau_e_r(i) &
9249 & - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
9250 end do
9251 end if
9252
9253 ! VOLUME FRACTION FLUX.
9254
9255# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9256#if defined(MFC_OpenACC)
9257# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9258!$acc loop seq
9259# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9260#elif defined(MFC_OpenMP)
9261# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9262
9263# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9264#endif
9265 do i = eqn_idx%adv%beg, eqn_idx%adv%end
9266 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9267 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsx_vf(j &
9268 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9269 end do
9270
9271 ! VOLUME FRACTION SOURCE FLUX.
9272
9273# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9274#if defined(MFC_OpenACC)
9275# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9276!$acc loop seq
9277# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9278#elif defined(MFC_OpenMP)
9279# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9280
9281# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9282#endif
9283 do i = 1, num_dims
9284 vel_src_rsx_vf(j, k, l, &
9285 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*(xi_l &
9286 & - 1._wp)) + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*(xi_r &
9287 & - 1._wp))
9288 end do
9289
9290 ! COLOR FUNCTION FLUX
9291 if (surface_tension) then
9292 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
9293 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9294 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
9295 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9296 end if
9297
9298 ! Hyperelastic reference map flux for material deformation tracking
9299 if (hyperelasticity) then
9300
9301# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9302#if defined(MFC_OpenACC)
9303# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9304!$acc loop seq
9305# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9306#elif defined(MFC_OpenMP)
9307# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9308
9309# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9310#endif
9311 do i = 1, num_dims
9312 flux_rsx_vf(j, k, l, &
9313 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s)) &
9314 & *(s_l*rho_l*xi_field_l(i) - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) &
9315 & + xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
9316 & - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
9317 end do
9318 end if
9319
9320 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
9321
9322 if (chemistry) then
9323
9324# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9325#if defined(MFC_OpenACC)
9326# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9327!$acc loop seq
9328# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9329#elif defined(MFC_OpenMP)
9330# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9331
9332# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9333#endif
9334 do i = eqn_idx%species%beg, eqn_idx%species%end
9335 y_l = ql_prim_rsx_vf(j, k, l, i)
9336 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
9337
9338 flux_rsx_vf(j, k, l, &
9339 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9340 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9341 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
9342 end do
9343 end if
9344
9345 ! Geometrical source flux for cylindrical coordinates
9346# 3280 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9347# 3298 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9348 end do
9349 end do
9350 end do
9351
9352# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9353#if defined(MFC_OpenACC)
9354# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9355!$acc end parallel loop
9356# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9357#elif defined(MFC_OpenMP)
9358# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9359
9360# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9361!$omp end target teams loop
9362# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9363#endif
9364 end if
9365 end if
9366# 1804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9367 if (norm_dir == 2) then
9368 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
9369 if (model_eqns == 3) then
9370 ! 6-equation model (model_eqns=3): separate phasic internal energies
9371
9372# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9373
9374# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9375#if defined(MFC_OpenACC)
9376# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9377!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
9378# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9379#elif defined(MFC_OpenMP)
9380# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9381
9382# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9383
9384# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9385
9386# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9387!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
9388# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9389#endif
9390# 1818 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9391 do l = is3%beg, is3%end
9392 do k = is2%beg, is2%end
9393 do j = is1%beg, is1%end
9394 vel_l_rms = 0._wp; vel_r_rms = 0._wp
9395 rho_l = 0._wp; rho_r = 0._wp
9396 gamma_l = 0._wp; gamma_r = 0._wp
9397 pi_inf_l = 0._wp; pi_inf_r = 0._wp
9398 qv_l = 0._wp; qv_r = 0._wp
9399 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
9400
9401
9402# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9403#if defined(MFC_OpenACC)
9404# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9405!$acc loop seq
9406# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9407#elif defined(MFC_OpenMP)
9408# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9409
9410# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9411#endif
9412 do i = 1, num_dims
9413 vel_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%cont%end + i)
9414 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%cont%end + i)
9415 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
9416 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
9417 end do
9418
9419 pres_l = ql_prim_rsy_vf(j, k, l, eqn_idx%E)
9420 pres_r = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E)
9421
9422 rho_l = 0._wp
9423 gamma_l = 0._wp
9424 pi_inf_l = 0._wp
9425 qv_l = 0._wp
9426
9427 rho_r = 0._wp
9428 gamma_r = 0._wp
9429 pi_inf_r = 0._wp
9430 qv_r = 0._wp
9431
9432 alpha_l_sum = 0._wp
9433 alpha_r_sum = 0._wp
9434
9435 if (mpp_lim) then
9436
9437# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9438#if defined(MFC_OpenACC)
9439# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9440!$acc loop seq
9441# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9442#elif defined(MFC_OpenMP)
9443# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9444
9445# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9446#endif
9447 do i = 1, num_fluids
9448 ql_prim_rsy_vf(j, k, l, i) = max(0._wp, ql_prim_rsy_vf(j, k, l, i))
9449 ql_prim_rsy_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsy_vf(j, k, &
9450 & l, eqn_idx%E + i)), 1._wp)
9451 alpha_l_sum = alpha_l_sum + ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)
9452 end do
9453
9454
9455# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9456#if defined(MFC_OpenACC)
9457# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9458!$acc loop seq
9459# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9460#elif defined(MFC_OpenMP)
9461# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9462
9463# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9464#endif
9465 do i = 1, num_fluids
9466 qr_prim_rsy_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsy_vf(j + 1, k, l, i))
9467 qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
9468 & qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
9469 alpha_r_sum = alpha_r_sum + qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)
9470 end do
9471
9472
9473# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9474#if defined(MFC_OpenACC)
9475# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9476!$acc loop seq
9477# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9478#elif defined(MFC_OpenMP)
9479# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9480
9481# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9482#endif
9483 do i = 1, num_fluids
9484 ql_prim_rsy_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsy_vf(j, k, l, &
9485 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
9486 qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsy_vf(j + 1, k, l, &
9487 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
9488 end do
9489 end if
9490
9491
9492# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9493#if defined(MFC_OpenACC)
9494# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9495!$acc loop seq
9496# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9497#elif defined(MFC_OpenMP)
9498# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9499
9500# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9501#endif
9502 do i = 1, num_fluids
9503 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
9504 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)*gammas(i)
9505 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
9506 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
9507
9508 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
9509 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
9510 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
9511 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
9512
9513 alpha_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%adv%beg + i - 1)
9514 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%adv%beg + i - 1)
9515 end do
9516
9517 if (viscous) then
9518
9519# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9520#if defined(MFC_OpenACC)
9521# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9522!$acc loop seq
9523# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9524#elif defined(MFC_OpenMP)
9525# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9526
9527# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9528#endif
9529 do i = 1, 2
9530 re_l(i) = dflt_real
9531 re_r(i) = dflt_real
9532 if (re_size(i) > 0) re_l(i) = 0._wp
9533 if (re_size(i) > 0) re_r(i) = 0._wp
9534
9535# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9536#if defined(MFC_OpenACC)
9537# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9538!$acc loop seq
9539# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9540#elif defined(MFC_OpenMP)
9541# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9542
9543# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9544#endif
9545 do q = 1, re_size(i)
9546 re_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
9547 re_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, &
9548 & q) + re_r(i)
9549 end do
9550 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
9551 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
9552 end do
9553 end if
9554
9555 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
9556 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
9557
9558 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
9559 if (hypoelasticity) then
9560
9561# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9562#if defined(MFC_OpenACC)
9563# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9564!$acc loop seq
9565# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9566#elif defined(MFC_OpenMP)
9567# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9568
9569# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9570#endif
9571 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
9572 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
9573 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
9574 end do
9575 g_l = 0._wp; g_r = 0._wp
9576
9577# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9578#if defined(MFC_OpenACC)
9579# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9580!$acc loop seq
9581# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9582#elif defined(MFC_OpenMP)
9583# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9584
9585# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9586#endif
9587 do i = 1, num_fluids
9588 g_l = g_l + alpha_l(i)*gs_rs(i)
9589 g_r = g_r + alpha_r(i)*gs_rs(i)
9590 end do
9591
9592# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9593#if defined(MFC_OpenACC)
9594# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9595!$acc loop seq
9596# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9597#elif defined(MFC_OpenMP)
9598# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9599
9600# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9601#endif
9602 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
9603 ! Elastic contribution to energy if G large enough
9604 if ((g_l > verysmall) .and. (g_r > verysmall)) then
9605 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
9606 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
9607 ! Additional terms in 2D and 3D
9608 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
9609 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
9610 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
9611 end if
9612 end if
9613 end do
9614 end if
9615
9616 ! Hyperelastic stress contribution: strain energy added to total energy
9617 if (hyperelasticity) then
9618
9619# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9620#if defined(MFC_OpenACC)
9621# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9622!$acc loop seq
9623# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9624#elif defined(MFC_OpenMP)
9625# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9626
9627# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9628#endif
9629 do i = 1, num_dims
9630 xi_field_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
9631 xi_field_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
9632 end do
9633 g_l = 0._wp; g_r = 0._wp
9634
9635# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9636#if defined(MFC_OpenACC)
9637# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9638!$acc loop seq
9639# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9640#elif defined(MFC_OpenMP)
9641# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9642
9643# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9644#endif
9645 do i = 1, num_fluids
9646 ! Mixture left and right shear modulus
9647 g_l = g_l + alpha_l(i)*gs_rs(i)
9648 g_r = g_r + alpha_r(i)*gs_rs(i)
9649 end do
9650 ! Elastic contribution to energy if G large enough
9651 if (g_l > verysmall .and. g_r > verysmall) then
9652 e_l = e_l + g_l*ql_prim_rsy_vf(j, k, l, eqn_idx%xi%end + 1)
9653 e_r = e_r + g_r*qr_prim_rsy_vf(j + 1, k, l, eqn_idx%xi%end + 1)
9654 end if
9655
9656# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9657#if defined(MFC_OpenACC)
9658# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9659!$acc loop seq
9660# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9661#elif defined(MFC_OpenMP)
9662# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9663
9664# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9665#endif
9666 do i = 1, b_size - 1
9667 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
9668 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
9669 end do
9670 end if
9671
9672 h_l = (e_l + pres_l)/rho_l
9673 h_r = (e_r + pres_r)/rho_r
9674
9675 if (avg_state == 1) then
9676# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9677 rho_avg = sqrt(rho_l*rho_r)
9678# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9679
9680# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9681 vel_avg_rms = 0._wp
9682# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9683
9684# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9685
9686# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9687#if defined(MFC_OpenACC)
9688# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9689!$acc loop seq
9690# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9691#elif defined(MFC_OpenMP)
9692# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9693
9694# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9695#endif
9696# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9697 do i = 1, num_vels
9698# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9699 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
9700# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9701 end do
9702# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9703
9704# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9705 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
9706# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9707
9708# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9709 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
9710# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9711
9712# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9713 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
9714# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9715
9716# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9717 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
9718# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9719
9720# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9721 if (chemistry) then
9722# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9723 eps = 0.001_wp
9724# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9725 call get_species_enthalpies_rt(t_l, h_il)
9726# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9727 call get_species_enthalpies_rt(t_r, h_ir)
9728# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9729 h_il = h_il*gas_constant/molecular_weights*t_l
9730# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9731 h_ir = h_ir*gas_constant/molecular_weights*t_r
9732# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9733 call get_species_specific_heats_r(t_l, cp_il)
9734# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9735 call get_species_specific_heats_r(t_r, cp_ir)
9736# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9737
9738# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9739 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
9740# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9741 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
9742# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9743 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
9744# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9745 if (abs(t_l - t_r) < eps) then
9746# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9747 ! Case when T_L and T_R are very close
9748# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9749 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
9750# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9751 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
9752# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9753 & - gas_constant/molecular_weights(:)))
9754# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9755 else
9756# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9757 ! Normal calculation when T_L and T_R are sufficiently different
9758# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9759 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
9760# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9761 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
9762# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9763 end if
9764# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9765 gamma_avg = cp_avg/cv_avg
9766# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9767
9768# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9769 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
9770# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9771 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
9772# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9773 end if
9774# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9775 end if
9776# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9777
9778# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9779 if (avg_state == 2) then
9780# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9781 rho_avg = 5.e-1_wp*(rho_l + rho_r)
9782# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9783 vel_avg_rms = 0._wp
9784# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9785
9786# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9787#if defined(MFC_OpenACC)
9788# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9789!$acc loop seq
9790# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9791#elif defined(MFC_OpenMP)
9792# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9793
9794# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9795#endif
9796# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9797 do i = 1, num_vels
9798# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9799 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
9800# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9801 end do
9802# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9803
9804# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9805 h_avg = 5.e-1_wp*(h_l + h_r)
9806# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9807 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
9808# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9809 qv_avg = 5.e-1_wp*(qv_l + qv_r)
9810# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9811 end if
9812
9813 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
9814 & c_l, qv_l)
9815
9816 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
9817 & c_r, qv_r)
9818
9819 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
9820 ! variables are placeholders to call the subroutine.
9821 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
9822 & 0._wp, c_avg, qv_avg)
9823
9824 if (viscous) then
9825
9826# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9827#if defined(MFC_OpenACC)
9828# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9829!$acc loop seq
9830# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9831#elif defined(MFC_OpenMP)
9832# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9833
9834# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9835#endif
9836 do i = 1, 2
9837 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
9838 end do
9839 end if
9840
9841 ! Low Mach correction
9842 if (low_mach == 2) then
9843 if (riemann_solver == 1 .or. riemann_solver == 5) then
9844# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9845 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9846# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9847 pcorr = 0._wp
9848# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9849
9850# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9851 if (low_mach == 1) then
9852# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9853 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9854# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9855 end if
9856# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9857 else if (riemann_solver == 2) then
9858# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9859 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9860# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9861 pcorr = 0._wp
9862# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9863
9864# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9865 if (low_mach == 1) then
9866# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9867 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
9868# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9869 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9870# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9871 else if (low_mach == 2) then
9872# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9873 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9874# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9875 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
9876# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9877 vel_l(dir_idx(1)) = vel_l_tmp
9878# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9879 vel_r(dir_idx(1)) = vel_r_tmp
9880# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9881 end if
9882# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9883 end if
9884 end if
9885
9886 ! COMPUTING THE DIRECT WAVE SPEEDS
9887 if (wave_speeds == 1) then
9888 if (elasticity) then
9889 ! Elastic wave speed, Rodriguez et al. JCP (2019)
9890 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1) &
9891 & ))/rho_l), &
9892 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
9893 & + tau_e_r(dir_idx_tau(1)))/rho_r))
9894 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1) &
9895 & ))/rho_r), &
9896 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
9897 & + tau_e_l(dir_idx_tau(1)))/rho_l))
9898 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
9899 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
9900 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
9901 & - vel_r(dir_idx(1))))
9902 else
9903 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
9904 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
9905 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
9906 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
9907 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
9908 end if
9909 else if (wave_speeds == 2) then
9910 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9911
9912 pres_sr = pres_sl
9913
9914 ! Low Mach correction: Thornber et al. JCP (2008)
9915 ms_l = max(1._wp, &
9916 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
9917 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
9918 ms_r = max(1._wp, &
9919 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
9920 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
9921
9922 s_l = vel_l(dir_idx(1)) - c_l*ms_l
9923 s_r = vel_r(dir_idx(1)) + c_r*ms_r
9924
9925 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
9926 end if
9927
9928 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
9929 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
9930
9931 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
9932 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
9933 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
9934
9935 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
9936 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
9937 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
9938
9939 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
9940 xi_mp = -min(0._wp, sign(1._wp, s_l))
9941 xi_pp = max(0._wp, sign(1._wp, s_r))
9942
9943 e_star = xi_m*(e_l + xi_mp*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l &
9944 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
9945 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
9946 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
9947 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
9948
9949 rho_star = xi_m*(rho_l*(xi_mp*xi_l + 1._wp - xi_mp)) + xi_p*(rho_r*(xi_pp*xi_r + 1._wp - xi_pp))
9950
9951 vel_k_star = vel_l(dir_idx(1))*(1._wp - xi_mp) + xi_mp*vel_r(dir_idx(1)) + xi_mp*xi_pp*(s_s &
9952 & - vel_r(dir_idx(1)))
9953
9954 ! Low Mach correction
9955 if (low_mach == 1) then
9956 if (riemann_solver == 1 .or. riemann_solver == 5) then
9957# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9958 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9959# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9960 pcorr = 0._wp
9961# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9962
9963# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9964 if (low_mach == 1) then
9965# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9966 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9967# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9968 end if
9969# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9970 else if (riemann_solver == 2) then
9971# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9972 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9973# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9974 pcorr = 0._wp
9975# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9976
9977# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9978 if (low_mach == 1) then
9979# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9980 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
9981# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9982 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9983# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9984 else if (low_mach == 2) then
9985# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9986 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9987# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9988 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
9989# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9990 vel_l(dir_idx(1)) = vel_l_tmp
9991# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9992 vel_r(dir_idx(1)) = vel_r_tmp
9993# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9994 end if
9995# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9996 end if
9997 else
9998 pcorr = 0._wp
9999 end if
10000
10001 ! COMPUTING FLUXES MASS FLUX.
10002
10003# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10004#if defined(MFC_OpenACC)
10005# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10006!$acc loop seq
10007# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10008#elif defined(MFC_OpenMP)
10009# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10010
10011# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10012#endif
10013 do i = 1, eqn_idx%cont%end
10014 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
10015 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsy_vf(j &
10016 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10017 end do
10018
10019 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
10020
10021# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10022#if defined(MFC_OpenACC)
10023# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10024!$acc loop seq
10025# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10026#elif defined(MFC_OpenMP)
10027# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10028
10029# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10030#endif
10031 do i = 1, num_dims
10032 flux_rsy_vf(j, k, l, &
10033 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
10034 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
10035 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l) &
10036 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
10037 end do
10038
10039 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
10040 flux_rsy_vf(j, k, l, eqn_idx%E) = (e_star + p_star)*vel_k_star + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
10041
10042 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
10043 if (elasticity) then
10044 flux_ene_e = 0._wp
10045
10046# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10047#if defined(MFC_OpenACC)
10048# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10049!$acc loop seq
10050# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10051#elif defined(MFC_OpenMP)
10052# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10053
10054# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10055#endif
10056 do i = 1, num_dims
10057 ! MOMENTUM ELASTIC FLUX.
10058 flux_rsy_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsy_vf(j, k, l, &
10059 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
10060 & - xi_p*tau_e_r(dir_idx_tau(i))
10061 ! ENERGY ELASTIC FLUX.
10062 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
10063 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
10064 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
10065 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
10066 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
10067 end do
10068 flux_rsy_vf(j, k, l, eqn_idx%E) = flux_rsy_vf(j, k, l, eqn_idx%E) + flux_ene_e
10069 end if
10070
10071 ! VOLUME FRACTION FLUX.
10072
10073# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10074#if defined(MFC_OpenACC)
10075# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10076!$acc loop seq
10077# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10078#elif defined(MFC_OpenMP)
10079# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10080
10081# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10082#endif
10083 do i = eqn_idx%adv%beg, eqn_idx%adv%end
10084 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
10085 & i)*s_s + xi_p*qr_prim_rsy_vf(j + 1, k, l, i)*s_s
10086 end do
10087
10088 ! Advection velocity source: interface velocity for volume fraction transport
10089
10090# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10091#if defined(MFC_OpenACC)
10092# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10093!$acc loop seq
10094# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10095#elif defined(MFC_OpenMP)
10096# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10097
10098# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10099#endif
10100 do i = 1, num_dims
10101 vel_src_rsy_vf(j, k, l, &
10102 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
10103 & *(s_s*(xi_mp*(xi_l - 1) + 1) - vel_l(dir_idx(i)))) &
10104 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(s_s*(xi_pp*(xi_r - 1) &
10105 & + 1) - vel_r(dir_idx(i))))
10106 end do
10107
10108 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
10109 ! energy flux
10110
10111# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10112#if defined(MFC_OpenACC)
10113# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10114!$acc loop seq
10115# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10116#elif defined(MFC_OpenMP)
10117# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10118
10119# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10120#endif
10121 do i = 1, num_fluids
10122 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
10123 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
10124 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
10125 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
10126 & + pres_r)
10127
10128 flux_rsy_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsy_vf(j, k, l, &
10129 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsy_vf(j + 1, k, l, &
10130 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
10131 & + (xi_m*ql_prim_rsy_vf(j, k, l, &
10132 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsy_vf(j + 1, k, l, &
10133 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
10134 & *pcorr*s_s*(xi_m*ql_prim_rsy_vf(j, k, l, &
10135 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsy_vf(j + 1, k, l, &
10136 & i + eqn_idx%adv%beg - 1))
10137 end do
10138
10139 flux_src_rsy_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsy_vf(j, k, l, dir_idx(1))
10140
10141 ! HYPOELASTIC STRESS EVOLUTION FLUX.
10142 if (hypoelasticity) then
10143
10144# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10145#if defined(MFC_OpenACC)
10146# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10147!$acc loop seq
10148# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10149#elif defined(MFC_OpenMP)
10150# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10151
10152# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10153#endif
10154 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
10155 flux_rsy_vf(j, k, l, &
10156 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s)) &
10157 & *(s_l*rho_l*tau_e_l(i) - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) &
10158 & + xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*tau_e_r(i) &
10159 & - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
10160 end do
10161 end if
10162
10163 ! Hyperelastic reference map flux for material deformation tracking
10164 if (hyperelasticity) then
10165
10166# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10167#if defined(MFC_OpenACC)
10168# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10169!$acc loop seq
10170# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10171#elif defined(MFC_OpenMP)
10172# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10173
10174# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10175#endif
10176 do i = 1, num_dims
10177 flux_rsy_vf(j, k, l, &
10178 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s)) &
10179 & *(s_l*rho_l*xi_field_l(i) - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) &
10180 & + xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
10181 & - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
10182 end do
10183 end if
10184
10185 ! COLOR FUNCTION FLUX
10186 if (surface_tension) then
10187 flux_rsy_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsy_vf(j, k, l, &
10188 & eqn_idx%c) + xi_p*qr_prim_rsy_vf(j + 1, k, l, eqn_idx%c))*s_s
10189 end if
10190
10191 ! Geometrical source flux for cylindrical coordinates
10192# 2184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10193 if (cyl_coord) then
10194 ! Substituting the advective flux into the inviscid geometrical source flux
10195
10196# 2186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10197#if defined(MFC_OpenACC)
10198# 2186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10199!$acc loop seq
10200# 2186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10201#elif defined(MFC_OpenMP)
10202# 2186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10203
10204# 2186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10205#endif
10206 do i = 1, eqn_idx%E
10207 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
10208 end do
10209
10210# 2190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10211#if defined(MFC_OpenACC)
10212# 2190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10213!$acc loop seq
10214# 2190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10215#elif defined(MFC_OpenMP)
10216# 2190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10217
10218# 2190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10219#endif
10220 do i = eqn_idx%int_en%beg, eqn_idx%int_en%end
10221 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
10222 end do
10223 ! Recalculating the radial momentum geometric source flux
10224 flux_gsrc_rsy_vf(j, k, l, &
10225 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsy_vf(j, k, &
10226 & l, eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
10227 ! Geometrical source of the void fraction(s) is zero
10228
10229# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10230#if defined(MFC_OpenACC)
10231# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10232!$acc loop seq
10233# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10234#elif defined(MFC_OpenMP)
10235# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10236
10237# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10238#endif
10239 do i = eqn_idx%adv%beg, eqn_idx%adv%end
10240 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
10241 end do
10242 end if
10243# 2205 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10244# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10245 end do
10246 end do
10247 end do
10248
10249# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10250#if defined(MFC_OpenACC)
10251# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10252!$acc end parallel loop
10253# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10254#elif defined(MFC_OpenMP)
10255# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10256
10257# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10258!$omp end target teams loop
10259# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10260#endif
10261 else if (model_eqns == 4) then
10262 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
10263
10264# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10265
10266# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10267#if defined(MFC_OpenACC)
10268# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10269!$acc parallel loop collapse(3) gang vector default(present) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
10270# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10271#elif defined(MFC_OpenMP)
10272# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10273
10274# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10275
10276# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10277
10278# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10279!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
10280# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10281#endif
10282# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10283 do l = is3%beg, is3%end
10284 do k = is2%beg, is2%end
10285 do j = is1%beg, is1%end
10286 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10287 rho_l = 0._wp; rho_r = 0._wp
10288 gamma_l = 0._wp; gamma_r = 0._wp
10289 pi_inf_l = 0._wp; pi_inf_r = 0._wp
10290 qv_l = 0._wp; qv_r = 0._wp
10291
10292
10293# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10294#if defined(MFC_OpenACC)
10295# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10296!$acc loop seq
10297# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10298#elif defined(MFC_OpenMP)
10299# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10300
10301# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10302#endif
10303 do i = 1, eqn_idx%cont%end
10304 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
10305 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
10306 end do
10307
10308
10309# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10310#if defined(MFC_OpenACC)
10311# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10312!$acc loop seq
10313# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10314#elif defined(MFC_OpenMP)
10315# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10316
10317# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10318#endif
10319 do i = 1, num_dims
10320 vel_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%cont%end + i)
10321 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%cont%end + i)
10322 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
10323 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
10324 end do
10325
10326
10327# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10328#if defined(MFC_OpenACC)
10329# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10330!$acc loop seq
10331# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10332#elif defined(MFC_OpenMP)
10333# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10334
10335# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10336#endif
10337 do i = 1, num_fluids
10338 alpha_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)
10339 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)
10340 end do
10341
10342# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10343#if defined(MFC_OpenACC)
10344# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10345!$acc loop seq
10346# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10347#elif defined(MFC_OpenMP)
10348# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10349
10350# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10351#endif
10352 do i = 1, num_fluids
10353 alpha_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)
10354 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)
10355 end do
10356
10357
10358# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10359#if defined(MFC_OpenACC)
10360# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10361!$acc loop seq
10362# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10363#elif defined(MFC_OpenMP)
10364# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10365
10366# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10367#endif
10368 do i = 1, num_fluids
10369 rho_l = rho_l + alpha_rho_l(i)
10370 gamma_l = gamma_l + alpha_l(i)*gammas(i)
10371 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
10372 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
10373
10374 rho_r = rho_r + alpha_rho_r(i)
10375 gamma_r = gamma_r + alpha_r(i)*gammas(i)
10376 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
10377 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
10378 end do
10379
10380 pres_l = ql_prim_rsy_vf(j, k, l, eqn_idx%E)
10381 pres_r = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E)
10382
10383 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
10384 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
10385
10386 h_l = (e_l + pres_l)/rho_l
10387 h_r = (e_r + pres_r)/rho_r
10388
10389 if (avg_state == 1) then
10390# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10391 rho_avg = sqrt(rho_l*rho_r)
10392# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10393
10394# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10395 vel_avg_rms = 0._wp
10396# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10397
10398# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10399
10400# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10401#if defined(MFC_OpenACC)
10402# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10403!$acc loop seq
10404# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10405#elif defined(MFC_OpenMP)
10406# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10407
10408# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10409#endif
10410# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10411 do i = 1, num_vels
10412# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10413 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
10414# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10415 end do
10416# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10417
10418# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10419 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
10420# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10421
10422# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10423 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
10424# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10425
10426# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10427 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
10428# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10429
10430# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10431 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
10432# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10433
10434# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10435 if (chemistry) then
10436# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10437 eps = 0.001_wp
10438# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10439 call get_species_enthalpies_rt(t_l, h_il)
10440# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10441 call get_species_enthalpies_rt(t_r, h_ir)
10442# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10443 h_il = h_il*gas_constant/molecular_weights*t_l
10444# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10445 h_ir = h_ir*gas_constant/molecular_weights*t_r
10446# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10447 call get_species_specific_heats_r(t_l, cp_il)
10448# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10449 call get_species_specific_heats_r(t_r, cp_ir)
10450# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10451
10452# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10453 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
10454# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10455 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
10456# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10457 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
10458# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10459 if (abs(t_l - t_r) < eps) then
10460# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10461 ! Case when T_L and T_R are very close
10462# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10463 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
10464# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10465 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
10466# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10467 & - gas_constant/molecular_weights(:)))
10468# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10469 else
10470# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10471 ! Normal calculation when T_L and T_R are sufficiently different
10472# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10473 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
10474# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10475 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
10476# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10477 end if
10478# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10479 gamma_avg = cp_avg/cv_avg
10480# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10481
10482# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10483 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
10484# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10485 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
10486# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10487 end if
10488# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10489 end if
10490# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10491
10492# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10493 if (avg_state == 2) then
10494# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10495 rho_avg = 5.e-1_wp*(rho_l + rho_r)
10496# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10497 vel_avg_rms = 0._wp
10498# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10499
10500# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10501#if defined(MFC_OpenACC)
10502# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10503!$acc loop seq
10504# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10505#elif defined(MFC_OpenMP)
10506# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10507
10508# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10509#endif
10510# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10511 do i = 1, num_vels
10512# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10513 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
10514# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10515 end do
10516# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10517
10518# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10519 h_avg = 5.e-1_wp*(h_l + h_r)
10520# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10521 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
10522# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10523 qv_avg = 5.e-1_wp*(qv_l + qv_r)
10524# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10525 end if
10526
10527 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
10528 & c_l, qv_l)
10529
10530 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
10531 & c_r, qv_r)
10532
10533 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
10534 ! variables are placeholders to call the subroutine.
10535
10536 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
10537 & 0._wp, c_avg, qv_avg)
10538
10539 if (wave_speeds == 1) then
10540 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
10541 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
10542
10543 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
10544 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
10545 & - rho_r*(s_r - vel_r(dir_idx(1))))
10546 else if (wave_speeds == 2) then
10547 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
10548
10549 pres_sr = pres_sl
10550
10551 ! Low Mach correction: Thornber et al. JCP (2008)
10552 ms_l = max(1._wp, &
10553 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
10554 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
10555 ms_r = max(1._wp, &
10556 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
10557 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
10558
10559 s_l = vel_l(dir_idx(1)) - c_l*ms_l
10560 s_r = vel_r(dir_idx(1)) + c_r*ms_r
10561
10562 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
10563 end if
10564
10565 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
10566 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
10567
10568 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
10569 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
10570 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
10571
10572 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
10573 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
10574 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
10575
10576
10577# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10578#if defined(MFC_OpenACC)
10579# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10580!$acc loop seq
10581# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10582#elif defined(MFC_OpenMP)
10583# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10584
10585# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10586#endif
10587 do i = 1, eqn_idx%cont%end
10588 flux_rsy_vf(j, k, l, &
10589 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
10590 & + xi_p*alpha_rho_r(i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10591 end do
10592
10593 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
10594
10595# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10596#if defined(MFC_OpenACC)
10597# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10598!$acc loop seq
10599# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10600#elif defined(MFC_OpenMP)
10601# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10602
10603# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10604#endif
10605 do i = 1, num_dims
10606 flux_rsy_vf(j, k, l, &
10607 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
10608 & *vel_l(dir_idx(i)) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp &
10609 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) &
10610 & + dir_flg(dir_idx(i))*pres_l) + xi_p*(rho_r*(vel_r(dir_idx(1)) &
10611 & *vel_r(dir_idx(i)) + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp &
10612 & - dir_flg(dir_idx(i)))*vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) &
10613 & + dir_flg(dir_idx(i))*pres_r)
10614 end do
10615
10616 if (bubbles_euler) then
10617 ! Put p_tilde in
10618
10619# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10620#if defined(MFC_OpenACC)
10621# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10622!$acc loop seq
10623# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10624#elif defined(MFC_OpenMP)
10625# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10626
10627# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10628#endif
10629 do i = 1, num_dims
10630 flux_rsy_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsy_vf(j, k, l, &
10631 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i)) &
10632 & *(-1._wp*ptilde_l)) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
10633 end do
10634 end if
10635
10636 flux_rsy_vf(j, k, l, eqn_idx%E) = 0._wp
10637
10638
10639# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10640#if defined(MFC_OpenACC)
10641# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10642!$acc loop seq
10643# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10644#elif defined(MFC_OpenMP)
10645# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10646
10647# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10648#endif
10649 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
10650 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
10651 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsy_vf(j &
10652 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10653 end do
10654
10655 ! Advection velocity source: interface velocity for volume fraction transport
10656
10657# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10658#if defined(MFC_OpenACC)
10659# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10660!$acc loop seq
10661# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10662#elif defined(MFC_OpenMP)
10663# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10664
10665# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10666#endif
10667 do i = 1, num_dims
10668 vel_src_rsy_vf(j, k, l, dir_idx(i)) = 0._wp
10669 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
10670 end do
10671
10672 flux_src_rsy_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsy_vf(j, k, l, dir_idx(1))
10673
10674 ! Add advection flux for bubble variables
10675 if (bubbles_euler) then
10676
10677# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10678#if defined(MFC_OpenACC)
10679# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10680!$acc loop seq
10681# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10682#elif defined(MFC_OpenMP)
10683# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10684
10685# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10686#endif
10687 do i = eqn_idx%bub%beg, eqn_idx%bub%end
10688 flux_rsy_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsy_vf(j, k, l, &
10689 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
10690 & + xi_p*nbub_r*qr_prim_rsy_vf(j + 1, k, l, &
10691 & i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10692 end do
10693 end if
10694
10695 ! Geometrical source flux for cylindrical coordinates
10696
10697# 2403 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10698 if (cyl_coord) then
10699 ! Substituting the advective flux into the inviscid geometrical source flux
10700
10701# 2405 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10702#if defined(MFC_OpenACC)
10703# 2405 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10704!$acc loop seq
10705# 2405 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10706#elif defined(MFC_OpenMP)
10707# 2405 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10708
10709# 2405 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10710#endif
10711 do i = 1, eqn_idx%E
10712 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
10713 end do
10714 ! Recalculating the radial momentum geometric source flux
10715 flux_gsrc_rsy_vf(j, k, l, &
10716 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
10717 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
10718 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
10719 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
10720 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp &
10721 & - dir_flg(dir_idx(1)))*vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
10722 ! Geometrical source of the void fraction(s) is zero
10723
10724# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10725#if defined(MFC_OpenACC)
10726# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10727!$acc loop seq
10728# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10729#elif defined(MFC_OpenMP)
10730# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10731
10732# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10733#endif
10734 do i = eqn_idx%adv%beg, eqn_idx%adv%end
10735 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
10736 end do
10737 end if
10738# 2424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10739# 2441 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10740 end do
10741 end do
10742 end do
10743
10744# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10745#if defined(MFC_OpenACC)
10746# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10747!$acc end parallel loop
10748# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10749#elif defined(MFC_OpenMP)
10750# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10751
10752# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10753!$omp end target teams loop
10754# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10755#endif
10756 else if (model_eqns == 2 .and. bubbles_euler) then
10757 ! 5-equation model with Euler-Euler bubble dynamics
10758
10759# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10760
10761# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10762#if defined(MFC_OpenACC)
10763# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10764!$acc parallel loop collapse(3) gang vector default(present) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
10765# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10766#elif defined(MFC_OpenMP)
10767# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10768
10769# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10770
10771# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10772
10773# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10774!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
10775# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10776#endif
10777# 2455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10778 do l = is3%beg, is3%end
10779 do k = is2%beg, is2%end
10780 do j = is1%beg, is1%end
10781 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10782 rho_l = 0._wp; rho_r = 0._wp
10783 gamma_l = 0._wp; gamma_r = 0._wp
10784 pi_inf_l = 0._wp; pi_inf_r = 0._wp
10785 qv_l = 0._wp; qv_r = 0._wp
10786
10787
10788# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10789#if defined(MFC_OpenACC)
10790# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10791!$acc loop seq
10792# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10793#elif defined(MFC_OpenMP)
10794# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10795
10796# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10797#endif
10798 do i = 1, num_fluids
10799 alpha_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)
10800 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)
10801 end do
10802
10803 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10804
10805
10806# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10807#if defined(MFC_OpenACC)
10808# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10809!$acc loop seq
10810# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10811#elif defined(MFC_OpenMP)
10812# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10813
10814# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10815#endif
10816 do i = 1, num_dims
10817 vel_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%cont%end + i)
10818 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%cont%end + i)
10819 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
10820 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
10821 end do
10822
10823 ! Retain this in the refactor
10824 if (mpp_lim .and. (num_fluids > 2)) then
10825
10826# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10827#if defined(MFC_OpenACC)
10828# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10829!$acc loop seq
10830# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10831#elif defined(MFC_OpenMP)
10832# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10833
10834# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10835#endif
10836 do i = 1, num_fluids
10837 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
10838 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)*gammas(i)
10839 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
10840 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
10841 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
10842 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
10843 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
10844 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
10845 end do
10846 else if (num_fluids > 2) then
10847
10848# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10849#if defined(MFC_OpenACC)
10850# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10851!$acc loop seq
10852# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10853#elif defined(MFC_OpenMP)
10854# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10855
10856# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10857#endif
10858 do i = 1, num_fluids - 1
10859 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
10860 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)*gammas(i)
10861 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
10862 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
10863 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
10864 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
10865 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
10866 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
10867 end do
10868 else
10869 rho_l = ql_prim_rsy_vf(j, k, l, 1)
10870 gamma_l = gammas(1)
10871 pi_inf_l = pi_infs(1)
10872 qv_l = qvs(1)
10873 rho_r = qr_prim_rsy_vf(j + 1, k, l, 1)
10874 gamma_r = gammas(1)
10875 pi_inf_r = pi_infs(1)
10876 qv_r = qvs(1)
10877 end if
10878
10879 if (viscous) then
10880 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
10881
10882# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10883#if defined(MFC_OpenACC)
10884# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10885!$acc loop seq
10886# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10887#elif defined(MFC_OpenMP)
10888# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10889
10890# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10891#endif
10892 do i = 1, 2
10893 re_l(i) = dflt_real
10894 re_r(i) = dflt_real
10895
10896 if (re_size(i) > 0) re_l(i) = 0._wp
10897 if (re_size(i) > 0) re_r(i) = 0._wp
10898
10899
10900# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10901#if defined(MFC_OpenACC)
10902# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10903!$acc loop seq
10904# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10905#elif defined(MFC_OpenMP)
10906# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10907
10908# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10909#endif
10910 do q = 1, re_size(i)
10911 re_l(i) = (1._wp - ql_prim_rsy_vf(j, k, l, eqn_idx%E + re_idx(i, &
10912 & q)))/res_gs(i, q) + re_l(i)
10913 re_r(i) = (1._wp - qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + re_idx(i, &
10914 & q)))/res_gs(i, q) + re_r(i)
10915 end do
10916
10917 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
10918 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
10919 end do
10920 end if
10921 end if
10922
10923 pres_l = ql_prim_rsy_vf(j, k, l, eqn_idx%E)
10924 pres_r = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E)
10925
10926 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
10927 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
10928
10929 h_l = (e_l + pres_l)/rho_l
10930 h_r = (e_r + pres_r)/rho_r
10931
10932 if (avg_state == 2) then
10933
10934# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10935#if defined(MFC_OpenACC)
10936# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10937!$acc loop seq
10938# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10939#elif defined(MFC_OpenMP)
10940# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10941
10942# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10943#endif
10944 do i = 1, nb
10945 r0_l(i) = ql_prim_rsy_vf(j, k, l, rs(i))
10946 r0_r(i) = qr_prim_rsy_vf(j + 1, k, l, rs(i))
10947
10948 v0_l(i) = ql_prim_rsy_vf(j, k, l, vs(i))
10949 v0_r(i) = qr_prim_rsy_vf(j + 1, k, l, vs(i))
10950 if (.not. polytropic .and. .not. qbmm) then
10951 p0_l(i) = ql_prim_rsy_vf(j, k, l, ps(i))
10952 p0_r(i) = qr_prim_rsy_vf(j + 1, k, l, ps(i))
10953 end if
10954 end do
10955
10956 if (.not. qbmm) then
10957 if (adv_n) then
10958 nbub_l = ql_prim_rsy_vf(j, k, l, eqn_idx%n)
10959 nbub_r = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%n)
10960 else
10961 nbub_l = 0._wp
10962 nbub_r = 0._wp
10963
10964# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10965#if defined(MFC_OpenACC)
10966# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10967!$acc loop seq
10968# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10969#elif defined(MFC_OpenMP)
10970# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10971
10972# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10973#endif
10974 do i = 1, nb
10975 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
10976 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
10977 end do
10978
10979 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsy_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
10980 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsy_vf(j + 1, k, l, &
10981 & eqn_idx%E + num_fluids)/nbub_r
10982 end if
10983 else
10984 ! nb stored in 0th moment of first R0 bin in variable conversion module
10985 nbub_l = ql_prim_rsy_vf(j, k, l, eqn_idx%bub%beg)
10986 nbub_r = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%bub%beg)
10987 end if
10988
10989
10990# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10991#if defined(MFC_OpenACC)
10992# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10993!$acc loop seq
10994# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10995#elif defined(MFC_OpenMP)
10996# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10997
10998# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10999#endif
11000 do i = 1, nb
11001 if (.not. qbmm) then
11002 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
11003 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
11004 end if
11005 end do
11006
11007 if (qbmm) then
11008 pbwr3lbar = mom_sp_rsy_vf(j, k, l, 4)
11009 pbwr3rbar = mom_sp_rsy_vf(j + 1, k, l, 4)
11010
11011 r3lbar = mom_sp_rsy_vf(j, k, l, 1)
11012 r3rbar = mom_sp_rsy_vf(j + 1, k, l, 1)
11013
11014 r3v2lbar = mom_sp_rsy_vf(j, k, l, 3)
11015 r3v2rbar = mom_sp_rsy_vf(j + 1, k, l, 3)
11016 else
11017 pbwr3lbar = 0._wp
11018 pbwr3rbar = 0._wp
11019
11020 r3lbar = 0._wp
11021 r3rbar = 0._wp
11022
11023 r3v2lbar = 0._wp
11024 r3v2rbar = 0._wp
11025
11026
11027# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11028#if defined(MFC_OpenACC)
11029# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11030!$acc loop seq
11031# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11032#elif defined(MFC_OpenMP)
11033# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11034
11035# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11036#endif
11037 do i = 1, nb
11038 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
11039 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
11040
11041 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
11042 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
11043
11044 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
11045 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
11046 end do
11047 end if
11048
11049 rho_avg = 5.e-1_wp*(rho_l + rho_r)
11050 h_avg = 5.e-1_wp*(h_l + h_r)
11051 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
11052 qv_avg = 5.e-1_wp*(qv_l + qv_r)
11053 vel_avg_rms = 0._wp
11054
11055
11056# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11057#if defined(MFC_OpenACC)
11058# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11059!$acc loop seq
11060# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11061#elif defined(MFC_OpenMP)
11062# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11063
11064# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11065#endif
11066 do i = 1, num_dims
11067 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
11068 end do
11069 end if
11070
11071 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
11072 & c_l, qv_l)
11073
11074 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
11075 & c_r, qv_r)
11076
11077 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
11078 ! variables are placeholders to call the subroutine.
11079 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
11080 & 0._wp, c_avg, qv_avg)
11081
11082 if (viscous) then
11083
11084# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11085#if defined(MFC_OpenACC)
11086# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11087!$acc loop seq
11088# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11089#elif defined(MFC_OpenMP)
11090# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11091
11092# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11093#endif
11094 do i = 1, 2
11095 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
11096 end do
11097 end if
11098
11099 ! Low Mach correction
11100 if (low_mach == 2) then
11101 if (riemann_solver == 1 .or. riemann_solver == 5) then
11102# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11103 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11104# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11105 pcorr = 0._wp
11106# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11107
11108# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11109 if (low_mach == 1) then
11110# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11111 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
11112# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11113 end if
11114# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11115 else if (riemann_solver == 2) then
11116# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11117 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11118# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11119 pcorr = 0._wp
11120# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11121
11122# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11123 if (low_mach == 1) then
11124# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11125 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
11126# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11127 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
11128# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11129 else if (low_mach == 2) then
11130# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11131 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
11132# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11133 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
11134# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11135 vel_l(dir_idx(1)) = vel_l_tmp
11136# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11137 vel_r(dir_idx(1)) = vel_r_tmp
11138# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11139 end if
11140# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11141 end if
11142 end if
11143
11144 if (wave_speeds == 1) then
11145 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
11146 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
11147
11148 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
11149 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
11150 & - rho_r*(s_r - vel_r(dir_idx(1))))
11151 else if (wave_speeds == 2) then
11152 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
11153
11154 pres_sr = pres_sl
11155
11156 ! Low Mach correction: Thornber et al. JCP (2008)
11157 ms_l = max(1._wp, &
11158 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
11159 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
11160 ms_r = max(1._wp, &
11161 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
11162 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
11163
11164 s_l = vel_l(dir_idx(1)) - c_l*ms_l
11165 s_r = vel_r(dir_idx(1)) + c_r*ms_r
11166
11167 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
11168 end if
11169
11170 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
11171 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
11172
11173 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
11174 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
11175 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
11176
11177 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
11178 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
11179 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
11180
11181 ! Low Mach correction
11182 if (low_mach == 1) then
11183 if (riemann_solver == 1 .or. riemann_solver == 5) then
11184# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11185 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11186# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11187 pcorr = 0._wp
11188# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11189
11190# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11191 if (low_mach == 1) then
11192# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11193 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
11194# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11195 end if
11196# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11197 else if (riemann_solver == 2) then
11198# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11199 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11200# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11201 pcorr = 0._wp
11202# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11203
11204# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11205 if (low_mach == 1) then
11206# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11207 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
11208# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11209 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
11210# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11211 else if (low_mach == 2) then
11212# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11213 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
11214# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11215 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
11216# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11217 vel_l(dir_idx(1)) = vel_l_tmp
11218# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11219 vel_r(dir_idx(1)) = vel_r_tmp
11220# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11221 end if
11222# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11223 end if
11224 else
11225 pcorr = 0._wp
11226 end if
11227
11228
11229# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11230#if defined(MFC_OpenACC)
11231# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11232!$acc loop seq
11233# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11234#elif defined(MFC_OpenMP)
11235# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11236
11237# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11238#endif
11239 do i = 1, eqn_idx%cont%end
11240 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
11241 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsy_vf(j &
11242 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11243 end do
11244
11245 if (bubbles_euler .and. (num_fluids > 1)) then
11246 ! Kill mass transport @ gas density
11247 flux_rsy_vf(j, k, l, eqn_idx%cont%end) = 0._wp
11248 end if
11249
11250 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
11251
11252 ! Include p_tilde
11253
11254 if (avg_state == 2) then
11255 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
11256 pres_l = pres_l - alpha_l(num_fluids)*pres_l
11257 else
11258 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
11259 end if
11260
11261 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
11262 pres_r = pres_r - alpha_r(num_fluids)*pres_r
11263 else
11264 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
11265 end if
11266 end if
11267
11268
11269# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11270#if defined(MFC_OpenACC)
11271# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11272!$acc loop seq
11273# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11274#elif defined(MFC_OpenMP)
11275# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11276
11277# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11278#endif
11279 do i = 1, num_dims
11280 flux_rsy_vf(j, k, l, &
11281 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
11282 & *vel_l(dir_idx(i)) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp &
11283 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) &
11284 & + dir_flg(dir_idx(i))*(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1)) &
11285 & *vel_r(dir_idx(i)) + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp &
11286 & - dir_flg(dir_idx(i)))*vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) &
11287 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i)) &
11288 & *pcorr
11289 end do
11290
11291 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
11292 flux_rsy_vf(j, k, l, &
11293 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
11294 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
11295 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s &
11296 & - vel_r(dir_idx(1)))*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) &
11297 & + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
11298
11299 ! Volume fraction flux
11300
11301# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11302#if defined(MFC_OpenACC)
11303# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11304!$acc loop seq
11305# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11306#elif defined(MFC_OpenMP)
11307# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11308
11309# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11310#endif
11311 do i = eqn_idx%adv%beg, eqn_idx%adv%end
11312 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
11313 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsy_vf(j &
11314 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11315 end do
11316
11317 ! Advection velocity source: interface velocity for volume fraction transport
11318
11319# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11320#if defined(MFC_OpenACC)
11321# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11322!$acc loop seq
11323# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11324#elif defined(MFC_OpenMP)
11325# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11326
11327# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11328#endif
11329 do i = 1, num_dims
11330 vel_src_rsy_vf(j, k, l, &
11331 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*(xi_l &
11332 & - 1._wp)) + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*(xi_r &
11333 & - 1._wp))
11334
11335 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
11336 end do
11337
11338 flux_src_rsy_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsy_vf(j, k, l, dir_idx(1))
11339
11340 ! Add advection flux for bubble variables
11341
11342# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11343#if defined(MFC_OpenACC)
11344# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11345!$acc loop seq
11346# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11347#elif defined(MFC_OpenMP)
11348# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11349
11350# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11351#endif
11352 do i = eqn_idx%bub%beg, eqn_idx%bub%end
11353 flux_rsy_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsy_vf(j, k, l, &
11354 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
11355 & + xi_p*nbub_r*qr_prim_rsy_vf(j + 1, k, l, &
11356 & i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11357 end do
11358
11359 if (qbmm) then
11360 flux_rsy_vf(j, k, l, &
11361 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
11362 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11363 end if
11364
11365 if (adv_n) then
11366 flux_rsy_vf(j, k, l, &
11367 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
11368 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11369 end if
11370
11371 ! Geometrical source flux for cylindrical coordinates
11372# 2800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11373 if (cyl_coord) then
11374 ! Substituting the advective flux into the inviscid geometrical source flux
11375
11376# 2802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11377#if defined(MFC_OpenACC)
11378# 2802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11379!$acc loop seq
11380# 2802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11381#elif defined(MFC_OpenMP)
11382# 2802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11383
11384# 2802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11385#endif
11386 do i = 1, eqn_idx%E
11387 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
11388 end do
11389 ! Recalculating the radial momentum geometric source flux
11390 flux_gsrc_rsy_vf(j, k, l, &
11391 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
11392 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
11393 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
11394 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
11395 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp &
11396 & - dir_flg(dir_idx(1)))*vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
11397 ! Geometrical source of the void fraction(s) is zero
11398
11399# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11400#if defined(MFC_OpenACC)
11401# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11402!$acc loop seq
11403# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11404#elif defined(MFC_OpenMP)
11405# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11406
11407# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11408#endif
11409 do i = eqn_idx%adv%beg, eqn_idx%adv%end
11410 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
11411 end do
11412 end if
11413# 2821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11414# 2839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11415 end do
11416 end do
11417 end do
11418
11419# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11420#if defined(MFC_OpenACC)
11421# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11422!$acc end parallel loop
11423# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11424#elif defined(MFC_OpenMP)
11425# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11426
11427# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11428!$omp end target teams loop
11429# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11430#endif
11431 else
11432 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
11433
11434# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11435
11436# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11437#if defined(MFC_OpenACC)
11438# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11439!$acc parallel loop collapse(3) gang vector default(present) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) copyin(is1, is2, is3)
11440# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11441#elif defined(MFC_OpenMP)
11442# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11443
11444# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11445
11446# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11447
11448# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11449!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) map(to:is1, is2, is3)
11450# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11451#endif
11452# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11453 do l = is3%beg, is3%end
11454 do k = is2%beg, is2%end
11455 do j = is1%beg, is1%end
11456 vel_l_rms = 0._wp; vel_r_rms = 0._wp
11457 rho_l = 0._wp; rho_r = 0._wp
11458 gamma_l = 0._wp; gamma_r = 0._wp
11459 pi_inf_l = 0._wp; pi_inf_r = 0._wp
11460 qv_l = 0._wp; qv_r = 0._wp
11461 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
11462
11463
11464# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11465#if defined(MFC_OpenACC)
11466# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11467!$acc loop seq
11468# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11469#elif defined(MFC_OpenMP)
11470# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11471
11472# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11473#endif
11474 do i = 1, num_fluids
11475 alpha_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)
11476 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)
11477 end do
11478
11479
11480# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11481#if defined(MFC_OpenACC)
11482# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11483!$acc loop seq
11484# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11485#elif defined(MFC_OpenMP)
11486# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11487
11488# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11489#endif
11490 do i = 1, num_dims
11491 vel_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%cont%end + i)
11492 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%cont%end + i)
11493 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
11494 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
11495 end do
11496
11497 pres_l = ql_prim_rsy_vf(j, k, l, eqn_idx%E)
11498 pres_r = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E)
11499
11500 ! Change this by splitting it into the cases present in the bubbles_euler
11501 if (mpp_lim) then
11502
11503# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11504#if defined(MFC_OpenACC)
11505# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11506!$acc loop seq
11507# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11508#elif defined(MFC_OpenMP)
11509# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11510
11511# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11512#endif
11513 do i = 1, num_fluids
11514 ql_prim_rsy_vf(j, k, l, i) = max(0._wp, ql_prim_rsy_vf(j, k, l, i))
11515 ql_prim_rsy_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsy_vf(j, k, &
11516 & l, eqn_idx%E + i)), 1._wp)
11517 qr_prim_rsy_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsy_vf(j + 1, k, l, i))
11518 qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
11519 & qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
11520 alpha_l_sum = alpha_l_sum + ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)
11521 alpha_r_sum = alpha_r_sum + qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)
11522 end do
11523
11524
11525# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11526#if defined(MFC_OpenACC)
11527# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11528!$acc loop seq
11529# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11530#elif defined(MFC_OpenMP)
11531# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11532
11533# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11534#endif
11535 do i = 1, num_fluids
11536 ql_prim_rsy_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsy_vf(j, k, l, &
11537 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
11538 qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsy_vf(j + 1, k, l, &
11539 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
11540 end do
11541 end if
11542
11543
11544# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11545#if defined(MFC_OpenACC)
11546# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11547!$acc loop seq
11548# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11549#elif defined(MFC_OpenMP)
11550# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11551
11552# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11553#endif
11554 do i = 1, num_fluids
11555 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
11556 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)*gammas(i)
11557 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
11558 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
11559
11560 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
11561 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
11562 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
11563 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
11564 end do
11565
11566 re_max = 0
11567 if (re_size(1) > 0) re_max = 1
11568 if (re_size(2) > 0) re_max = 2
11569
11570 if (viscous) then
11571
11572# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11573#if defined(MFC_OpenACC)
11574# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11575!$acc loop seq
11576# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11577#elif defined(MFC_OpenMP)
11578# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11579
11580# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11581#endif
11582 do i = 1, re_max
11583 re_l(i) = 0._wp
11584 re_r(i) = 0._wp
11585
11586
11587# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11588#if defined(MFC_OpenACC)
11589# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11590!$acc loop seq
11591# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11592#elif defined(MFC_OpenMP)
11593# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11594
11595# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11596#endif
11597 do q = 1, re_size(i)
11598 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
11599 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
11600 end do
11601
11602 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
11603 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
11604 end do
11605 end if
11606
11607 if (chemistry) then
11608 c_sum_yi_phi = 0.0_wp
11609
11610# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11611#if defined(MFC_OpenACC)
11612# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11613!$acc loop seq
11614# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11615#elif defined(MFC_OpenMP)
11616# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11617
11618# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11619#endif
11620 do i = eqn_idx%species%beg, eqn_idx%species%end
11621 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsy_vf(j, k, l, i)
11622 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsy_vf(j + 1, k, l, i)
11623 end do
11624
11625 call get_mixture_molecular_weight(ys_l, mw_l)
11626 call get_mixture_molecular_weight(ys_r, mw_r)
11627
11628# 2952 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11629 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
11630 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
11631# 2955 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11632
11633 r_gas_l = gas_constant/mw_l
11634 r_gas_r = gas_constant/mw_r
11635
11636 t_l = pres_l/rho_l/r_gas_l
11637 t_r = pres_r/rho_r/r_gas_r
11638
11639 call get_species_specific_heats_r(t_l, cp_il)
11640 call get_species_specific_heats_r(t_r, cp_ir)
11641
11642 if (chem_params%gamma_method == 1) then
11643 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
11644 gamma_il = cp_il/(cp_il - 1.0_wp)
11645 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
11646
11647 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
11648 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
11649 else if (chem_params%gamma_method == 2) then
11650 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
11651 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
11652 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
11653 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
11654 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
11655
11656 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
11657 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
11658 end if
11659
11660 call get_mixture_energy_mass(t_l, ys_l, e_l)
11661 call get_mixture_energy_mass(t_r, ys_r, e_r)
11662
11663 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
11664 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
11665 h_l = (e_l + pres_l)/rho_l
11666 h_r = (e_r + pres_r)/rho_r
11667 else
11668 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
11669 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
11670
11671 h_l = (e_l + pres_l)/rho_l
11672 h_r = (e_r + pres_r)/rho_r
11673 end if
11674
11675 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
11676 if (hypoelasticity) then
11677
11678# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11679#if defined(MFC_OpenACC)
11680# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11681!$acc loop seq
11682# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11683#elif defined(MFC_OpenMP)
11684# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11685
11686# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11687#endif
11688 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
11689 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
11690 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
11691 end do
11692 g_l = 0._wp
11693 g_r = 0._wp
11694
11695# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11696#if defined(MFC_OpenACC)
11697# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11698!$acc loop seq
11699# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11700#elif defined(MFC_OpenMP)
11701# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11702
11703# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11704#endif
11705 do i = 1, num_fluids
11706 g_l = g_l + alpha_l(i)*gs_rs(i)
11707 g_r = g_r + alpha_r(i)*gs_rs(i)
11708 end do
11709
11710# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11711#if defined(MFC_OpenACC)
11712# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11713!$acc loop seq
11714# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11715#elif defined(MFC_OpenMP)
11716# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11717
11718# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11719#endif
11720 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
11721 ! Elastic contribution to energy if G large enough
11722 if ((g_l > verysmall) .and. (g_r > verysmall)) then
11723 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
11724 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
11725 ! Additional terms in 2D and 3D
11726 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
11727 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
11728 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
11729 end if
11730 end if
11731 end do
11732 end if
11733
11734 ! Hyperelastic stress contribution: strain energy added to total energy
11735 if (hyperelasticity) then
11736
11737# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11738#if defined(MFC_OpenACC)
11739# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11740!$acc loop seq
11741# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11742#elif defined(MFC_OpenMP)
11743# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11744
11745# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11746#endif
11747 do i = 1, num_dims
11748 xi_field_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
11749 xi_field_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
11750 end do
11751 g_l = 0._wp
11752 g_r = 0._wp
11753
11754# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11755#if defined(MFC_OpenACC)
11756# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11757!$acc loop seq
11758# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11759#elif defined(MFC_OpenMP)
11760# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11761
11762# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11763#endif
11764 do i = 1, num_fluids
11765 ! Mixture left and right shear modulus
11766 g_l = g_l + alpha_l(i)*gs_rs(i)
11767 g_r = g_r + alpha_r(i)*gs_rs(i)
11768 end do
11769 ! Elastic contribution to energy if G large enough
11770 if (g_l > verysmall .and. g_r > verysmall) then
11771 e_l = e_l + g_l*ql_prim_rsy_vf(j, k, l, eqn_idx%xi%end + 1)
11772 e_r = e_r + g_r*qr_prim_rsy_vf(j + 1, k, l, eqn_idx%xi%end + 1)
11773 end if
11774
11775# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11776#if defined(MFC_OpenACC)
11777# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11778!$acc loop seq
11779# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11780#elif defined(MFC_OpenMP)
11781# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11782
11783# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11784#endif
11785 do i = 1, b_size - 1
11786 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
11787 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
11788 end do
11789 end if
11790
11791 h_l = (e_l + pres_l)/rho_l
11792 h_r = (e_r + pres_r)/rho_r
11793
11794 if (avg_state == 1) then
11795# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11796 rho_avg = sqrt(rho_l*rho_r)
11797# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11798
11799# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11800 vel_avg_rms = 0._wp
11801# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11802
11803# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11804
11805# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11806#if defined(MFC_OpenACC)
11807# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11808!$acc loop seq
11809# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11810#elif defined(MFC_OpenMP)
11811# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11812
11813# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11814#endif
11815# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11816 do i = 1, num_vels
11817# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11818 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
11819# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11820 end do
11821# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11822
11823# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11824 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
11825# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11826
11827# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11828 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
11829# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11830
11831# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11832 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
11833# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11834
11835# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11836 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
11837# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11838
11839# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11840 if (chemistry) then
11841# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11842 eps = 0.001_wp
11843# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11844 call get_species_enthalpies_rt(t_l, h_il)
11845# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11846 call get_species_enthalpies_rt(t_r, h_ir)
11847# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11848 h_il = h_il*gas_constant/molecular_weights*t_l
11849# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11850 h_ir = h_ir*gas_constant/molecular_weights*t_r
11851# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11852 call get_species_specific_heats_r(t_l, cp_il)
11853# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11854 call get_species_specific_heats_r(t_r, cp_ir)
11855# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11856
11857# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11858 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
11859# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11860 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
11861# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11862 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
11863# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11864 if (abs(t_l - t_r) < eps) then
11865# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11866 ! Case when T_L and T_R are very close
11867# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11868 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
11869# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11870 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
11871# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11872 & - gas_constant/molecular_weights(:)))
11873# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11874 else
11875# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11876 ! Normal calculation when T_L and T_R are sufficiently different
11877# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11878 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
11879# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11880 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
11881# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11882 end if
11883# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11884 gamma_avg = cp_avg/cv_avg
11885# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11886
11887# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11888 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
11889# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11890 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
11891# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11892 end if
11893# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11894 end if
11895# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11896
11897# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11898 if (avg_state == 2) then
11899# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11900 rho_avg = 5.e-1_wp*(rho_l + rho_r)
11901# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11902 vel_avg_rms = 0._wp
11903# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11904
11905# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11906#if defined(MFC_OpenACC)
11907# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11908!$acc loop seq
11909# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11910#elif defined(MFC_OpenMP)
11911# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11912
11913# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11914#endif
11915# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11916 do i = 1, num_vels
11917# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11918 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
11919# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11920 end do
11921# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11922
11923# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11924 h_avg = 5.e-1_wp*(h_l + h_r)
11925# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11926 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
11927# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11928 qv_avg = 5.e-1_wp*(qv_l + qv_r)
11929# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11930 end if
11931
11932 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
11933 & c_l, qv_l)
11934
11935 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
11936 & c_r, qv_r)
11937
11938 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
11939 ! variables are placeholders to call the subroutine.
11940 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
11941 & c_sum_yi_phi, c_avg, qv_avg)
11942
11943 if (viscous) then
11944 if (chemistry) then
11945 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
11946 end if
11947
11948# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11949#if defined(MFC_OpenACC)
11950# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11951!$acc loop seq
11952# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11953#elif defined(MFC_OpenMP)
11954# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11955
11956# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11957#endif
11958 do i = 1, 2
11959 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
11960 end do
11961 end if
11962
11963 ! Low Mach correction
11964 if (low_mach == 2) then
11965 if (riemann_solver == 1 .or. riemann_solver == 5) then
11966# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11967 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11968# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11969 pcorr = 0._wp
11970# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11971
11972# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11973 if (low_mach == 1) then
11974# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11975 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
11976# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11977 end if
11978# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11979 else if (riemann_solver == 2) then
11980# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11981 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11982# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11983 pcorr = 0._wp
11984# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11985
11986# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11987 if (low_mach == 1) then
11988# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11989 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
11990# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11991 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
11992# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11993 else if (low_mach == 2) then
11994# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11995 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
11996# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11997 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
11998# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11999 vel_l(dir_idx(1)) = vel_l_tmp
12000# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12001 vel_r(dir_idx(1)) = vel_r_tmp
12002# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12003 end if
12004# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12005 end if
12006 end if
12007
12008 if (wave_speeds == 1) then
12009 if (elasticity) then
12010 ! Elastic wave speed, Rodriguez et al. JCP (2019)
12011 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1) &
12012 & ))/rho_l), &
12013 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
12014 & + tau_e_r(dir_idx_tau(1)))/rho_r))
12015 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1) &
12016 & ))/rho_r), &
12017 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
12018 & + tau_e_l(dir_idx_tau(1)))/rho_l))
12019 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
12020 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
12021 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
12022 & - vel_r(dir_idx(1))))
12023 else
12024 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
12025 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
12026 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
12027 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
12028 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
12029 end if
12030 else if (wave_speeds == 2) then
12031 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
12032
12033 pres_sr = pres_sl
12034
12035 ! Low Mach correction: Thornber et al. JCP (2008)
12036 ms_l = max(1._wp, &
12037 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
12038 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
12039 ms_r = max(1._wp, &
12040 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
12041 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
12042
12043 s_l = vel_l(dir_idx(1)) - c_l*ms_l
12044 s_r = vel_r(dir_idx(1)) + c_r*ms_r
12045
12046 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
12047 end if
12048
12049 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
12050 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
12051
12052 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
12053 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
12054 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
12055
12056 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
12057 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
12058 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
12059
12060 ! Low Mach correction
12061 if (low_mach == 1) then
12062 if (riemann_solver == 1 .or. riemann_solver == 5) then
12063# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12064 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12065# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12066 pcorr = 0._wp
12067# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12068
12069# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12070 if (low_mach == 1) then
12071# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12072 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12073# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12074 end if
12075# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12076 else if (riemann_solver == 2) then
12077# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12078 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12079# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12080 pcorr = 0._wp
12081# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12082
12083# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12084 if (low_mach == 1) then
12085# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12086 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
12087# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12088 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
12089# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12090 else if (low_mach == 2) then
12091# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12092 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
12093# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12094 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
12095# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12096 vel_l(dir_idx(1)) = vel_l_tmp
12097# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12098 vel_r(dir_idx(1)) = vel_r_tmp
12099# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12100 end if
12101# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12102 end if
12103 else
12104 pcorr = 0._wp
12105 end if
12106
12107 ! COMPUTING THE HLLC FLUXES MASS FLUX.
12108
12109# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12110#if defined(MFC_OpenACC)
12111# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12112!$acc loop seq
12113# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12114#elif defined(MFC_OpenMP)
12115# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12116
12117# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12118#endif
12119 do i = 1, eqn_idx%cont%end
12120 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
12121 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsy_vf(j &
12122 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12123 end do
12124
12125 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
12126
12127# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12128#if defined(MFC_OpenACC)
12129# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12130!$acc loop seq
12131# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12132#elif defined(MFC_OpenMP)
12133# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12134
12135# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12136#endif
12137 do i = 1, num_dims
12138 flux_rsy_vf(j, k, l, &
12139 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
12140 & *vel_l(dir_idx(i)) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp &
12141 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) &
12142 & + dir_flg(dir_idx(i))*(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1)) &
12143 & *vel_r(dir_idx(i)) + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp &
12144 & - dir_flg(dir_idx(i)))*vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) &
12145 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i)) &
12146 & *pcorr
12147 end do
12148
12149 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
12150 flux_rsy_vf(j, k, l, &
12151 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
12152 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1))))) - e_l)) &
12153 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s &
12154 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r)) &
12155 & + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
12156
12157 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
12158 if (elasticity) then
12159 flux_ene_e = 0._wp
12160
12161# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12162#if defined(MFC_OpenACC)
12163# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12164!$acc loop seq
12165# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12166#elif defined(MFC_OpenMP)
12167# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12168
12169# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12170#endif
12171 do i = 1, num_dims
12172 ! MOMENTUM ELASTIC FLUX.
12173 flux_rsy_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsy_vf(j, k, l, &
12174 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
12175 & - xi_p*tau_e_r(dir_idx_tau(i))
12176 ! ENERGY ELASTIC FLUX.
12177 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
12178 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
12179 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
12180 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
12181 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
12182 end do
12183 flux_rsy_vf(j, k, l, eqn_idx%E) = flux_rsy_vf(j, k, l, eqn_idx%E) + flux_ene_e
12184 end if
12185
12186 ! HYPOELASTIC STRESS EVOLUTION FLUX.
12187 if (hypoelasticity) then
12188
12189# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12190#if defined(MFC_OpenACC)
12191# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12192!$acc loop seq
12193# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12194#elif defined(MFC_OpenMP)
12195# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12196
12197# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12198#endif
12199 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
12200 flux_rsy_vf(j, k, l, &
12201 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s)) &
12202 & *(s_l*rho_l*tau_e_l(i) - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) &
12203 & + xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*tau_e_r(i) &
12204 & - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
12205 end do
12206 end if
12207
12208 ! VOLUME FRACTION FLUX.
12209
12210# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12211#if defined(MFC_OpenACC)
12212# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12213!$acc loop seq
12214# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12215#elif defined(MFC_OpenMP)
12216# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12217
12218# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12219#endif
12220 do i = eqn_idx%adv%beg, eqn_idx%adv%end
12221 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
12222 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsy_vf(j &
12223 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12224 end do
12225
12226 ! VOLUME FRACTION SOURCE FLUX.
12227
12228# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12229#if defined(MFC_OpenACC)
12230# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12231!$acc loop seq
12232# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12233#elif defined(MFC_OpenMP)
12234# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12235
12236# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12237#endif
12238 do i = 1, num_dims
12239 vel_src_rsy_vf(j, k, l, &
12240 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*(xi_l &
12241 & - 1._wp)) + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*(xi_r &
12242 & - 1._wp))
12243 end do
12244
12245 ! COLOR FUNCTION FLUX
12246 if (surface_tension) then
12247 flux_rsy_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsy_vf(j, k, l, &
12248 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12249 & + xi_p*qr_prim_rsy_vf(j + 1, k, l, &
12250 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12251 end if
12252
12253 ! Hyperelastic reference map flux for material deformation tracking
12254 if (hyperelasticity) then
12255
12256# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12257#if defined(MFC_OpenACC)
12258# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12259!$acc loop seq
12260# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12261#elif defined(MFC_OpenMP)
12262# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12263
12264# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12265#endif
12266 do i = 1, num_dims
12267 flux_rsy_vf(j, k, l, &
12268 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s)) &
12269 & *(s_l*rho_l*xi_field_l(i) - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) &
12270 & + xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
12271 & - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
12272 end do
12273 end if
12274
12275 flux_src_rsy_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsy_vf(j, k, l, dir_idx(1))
12276
12277 if (chemistry) then
12278
12279# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12280#if defined(MFC_OpenACC)
12281# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12282!$acc loop seq
12283# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12284#elif defined(MFC_OpenMP)
12285# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12286
12287# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12288#endif
12289 do i = eqn_idx%species%beg, eqn_idx%species%end
12290 y_l = ql_prim_rsy_vf(j, k, l, i)
12291 y_r = qr_prim_rsy_vf(j + 1, k, l, i)
12292
12293 flux_rsy_vf(j, k, l, &
12294 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12295 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12296 flux_src_rsy_vf(j, k, l, i) = 0.0_wp
12297 end do
12298 end if
12299
12300 ! Geometrical source flux for cylindrical coordinates
12301# 3259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12302 if (cyl_coord) then
12303 ! Substituting the advective flux into the inviscid geometrical source flux
12304
12305# 3261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12306#if defined(MFC_OpenACC)
12307# 3261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12308!$acc loop seq
12309# 3261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12310#elif defined(MFC_OpenMP)
12311# 3261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12312
12313# 3261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12314#endif
12315 do i = 1, eqn_idx%E
12316 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
12317 end do
12318 ! Recalculating the radial momentum geometric source flux
12319 flux_gsrc_rsy_vf(j, k, l, &
12320 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
12321 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
12322 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
12323 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
12324 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp &
12325 & - dir_flg(dir_idx(1)))*vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
12326 ! Geometrical source of the void fraction(s) is zero
12327
12328# 3274 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12329#if defined(MFC_OpenACC)
12330# 3274 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12331!$acc loop seq
12332# 3274 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12333#elif defined(MFC_OpenMP)
12334# 3274 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12335
12336# 3274 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12337#endif
12338 do i = eqn_idx%adv%beg, eqn_idx%adv%end
12339 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
12340 end do
12341 end if
12342# 3280 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12343# 3298 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12344 end do
12345 end do
12346 end do
12347
12348# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12349#if defined(MFC_OpenACC)
12350# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12351!$acc end parallel loop
12352# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12353#elif defined(MFC_OpenMP)
12354# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12355
12356# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12357!$omp end target teams loop
12358# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12359#endif
12360 end if
12361 end if
12362# 1804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12363 if (norm_dir == 3) then
12364 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
12365 if (model_eqns == 3) then
12366 ! 6-equation model (model_eqns=3): separate phasic internal energies
12367
12368# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12369
12370# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12371#if defined(MFC_OpenACC)
12372# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12373!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
12374# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12375#elif defined(MFC_OpenMP)
12376# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12377
12378# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12379
12380# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12381
12382# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12383!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
12384# 1808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12385#endif
12386# 1818 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12387 do l = is3%beg, is3%end
12388 do k = is2%beg, is2%end
12389 do j = is1%beg, is1%end
12390 vel_l_rms = 0._wp; vel_r_rms = 0._wp
12391 rho_l = 0._wp; rho_r = 0._wp
12392 gamma_l = 0._wp; gamma_r = 0._wp
12393 pi_inf_l = 0._wp; pi_inf_r = 0._wp
12394 qv_l = 0._wp; qv_r = 0._wp
12395 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
12396
12397
12398# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12399#if defined(MFC_OpenACC)
12400# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12401!$acc loop seq
12402# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12403#elif defined(MFC_OpenMP)
12404# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12405
12406# 1828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12407#endif
12408 do i = 1, num_dims
12409 vel_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%cont%end + i)
12410 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%cont%end + i)
12411 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
12412 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
12413 end do
12414
12415 pres_l = ql_prim_rsz_vf(j, k, l, eqn_idx%E)
12416 pres_r = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E)
12417
12418 rho_l = 0._wp
12419 gamma_l = 0._wp
12420 pi_inf_l = 0._wp
12421 qv_l = 0._wp
12422
12423 rho_r = 0._wp
12424 gamma_r = 0._wp
12425 pi_inf_r = 0._wp
12426 qv_r = 0._wp
12427
12428 alpha_l_sum = 0._wp
12429 alpha_r_sum = 0._wp
12430
12431 if (mpp_lim) then
12432
12433# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12434#if defined(MFC_OpenACC)
12435# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12436!$acc loop seq
12437# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12438#elif defined(MFC_OpenMP)
12439# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12440
12441# 1853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12442#endif
12443 do i = 1, num_fluids
12444 ql_prim_rsz_vf(j, k, l, i) = max(0._wp, ql_prim_rsz_vf(j, k, l, i))
12445 ql_prim_rsz_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsz_vf(j, k, &
12446 & l, eqn_idx%E + i)), 1._wp)
12447 alpha_l_sum = alpha_l_sum + ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)
12448 end do
12449
12450
12451# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12452#if defined(MFC_OpenACC)
12453# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12454!$acc loop seq
12455# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12456#elif defined(MFC_OpenMP)
12457# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12458
12459# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12460#endif
12461 do i = 1, num_fluids
12462 qr_prim_rsz_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsz_vf(j + 1, k, l, i))
12463 qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
12464 & qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
12465 alpha_r_sum = alpha_r_sum + qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)
12466 end do
12467
12468
12469# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12470#if defined(MFC_OpenACC)
12471# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12472!$acc loop seq
12473# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12474#elif defined(MFC_OpenMP)
12475# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12476
12477# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12478#endif
12479 do i = 1, num_fluids
12480 ql_prim_rsz_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsz_vf(j, k, l, &
12481 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
12482 qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsz_vf(j + 1, k, l, &
12483 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
12484 end do
12485 end if
12486
12487
12488# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12489#if defined(MFC_OpenACC)
12490# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12491!$acc loop seq
12492# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12493#elif defined(MFC_OpenMP)
12494# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12495
12496# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12497#endif
12498 do i = 1, num_fluids
12499 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
12500 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)*gammas(i)
12501 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
12502 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
12503
12504 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
12505 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
12506 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
12507 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
12508
12509 alpha_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%adv%beg + i - 1)
12510 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%adv%beg + i - 1)
12511 end do
12512
12513 if (viscous) then
12514
12515# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12516#if defined(MFC_OpenACC)
12517# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12518!$acc loop seq
12519# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12520#elif defined(MFC_OpenMP)
12521# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12522
12523# 1895 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12524#endif
12525 do i = 1, 2
12526 re_l(i) = dflt_real
12527 re_r(i) = dflt_real
12528 if (re_size(i) > 0) re_l(i) = 0._wp
12529 if (re_size(i) > 0) re_r(i) = 0._wp
12530
12531# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12532#if defined(MFC_OpenACC)
12533# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12534!$acc loop seq
12535# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12536#elif defined(MFC_OpenMP)
12537# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12538
12539# 1901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12540#endif
12541 do q = 1, re_size(i)
12542 re_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
12543 re_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, &
12544 & q) + re_r(i)
12545 end do
12546 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
12547 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
12548 end do
12549 end if
12550
12551 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
12552 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
12553
12554 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
12555 if (hypoelasticity) then
12556
12557# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12558#if defined(MFC_OpenACC)
12559# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12560!$acc loop seq
12561# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12562#elif defined(MFC_OpenMP)
12563# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12564
12565# 1917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12566#endif
12567 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
12568 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
12569 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
12570 end do
12571 g_l = 0._wp; g_r = 0._wp
12572
12573# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12574#if defined(MFC_OpenACC)
12575# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12576!$acc loop seq
12577# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12578#elif defined(MFC_OpenMP)
12579# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12580
12581# 1923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12582#endif
12583 do i = 1, num_fluids
12584 g_l = g_l + alpha_l(i)*gs_rs(i)
12585 g_r = g_r + alpha_r(i)*gs_rs(i)
12586 end do
12587
12588# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12589#if defined(MFC_OpenACC)
12590# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12591!$acc loop seq
12592# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12593#elif defined(MFC_OpenMP)
12594# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12595
12596# 1928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12597#endif
12598 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
12599 ! Elastic contribution to energy if G large enough
12600 if ((g_l > verysmall) .and. (g_r > verysmall)) then
12601 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
12602 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
12603 ! Additional terms in 2D and 3D
12604 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
12605 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
12606 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
12607 end if
12608 end if
12609 end do
12610 end if
12611
12612 ! Hyperelastic stress contribution: strain energy added to total energy
12613 if (hyperelasticity) then
12614
12615# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12616#if defined(MFC_OpenACC)
12617# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12618!$acc loop seq
12619# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12620#elif defined(MFC_OpenMP)
12621# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12622
12623# 1945 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12624#endif
12625 do i = 1, num_dims
12626 xi_field_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
12627 xi_field_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
12628 end do
12629 g_l = 0._wp; g_r = 0._wp
12630
12631# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12632#if defined(MFC_OpenACC)
12633# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12634!$acc loop seq
12635# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12636#elif defined(MFC_OpenMP)
12637# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12638
12639# 1951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12640#endif
12641 do i = 1, num_fluids
12642 ! Mixture left and right shear modulus
12643 g_l = g_l + alpha_l(i)*gs_rs(i)
12644 g_r = g_r + alpha_r(i)*gs_rs(i)
12645 end do
12646 ! Elastic contribution to energy if G large enough
12647 if (g_l > verysmall .and. g_r > verysmall) then
12648 e_l = e_l + g_l*ql_prim_rsz_vf(j, k, l, eqn_idx%xi%end + 1)
12649 e_r = e_r + g_r*qr_prim_rsz_vf(j + 1, k, l, eqn_idx%xi%end + 1)
12650 end if
12651
12652# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12653#if defined(MFC_OpenACC)
12654# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12655!$acc loop seq
12656# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12657#elif defined(MFC_OpenMP)
12658# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12659
12660# 1962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12661#endif
12662 do i = 1, b_size - 1
12663 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
12664 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
12665 end do
12666 end if
12667
12668 h_l = (e_l + pres_l)/rho_l
12669 h_r = (e_r + pres_r)/rho_r
12670
12671 if (avg_state == 1) then
12672# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12673 rho_avg = sqrt(rho_l*rho_r)
12674# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12675
12676# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12677 vel_avg_rms = 0._wp
12678# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12679
12680# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12681
12682# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12683#if defined(MFC_OpenACC)
12684# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12685!$acc loop seq
12686# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12687#elif defined(MFC_OpenMP)
12688# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12689
12690# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12691#endif
12692# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12693 do i = 1, num_vels
12694# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12695 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
12696# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12697 end do
12698# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12699
12700# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12701 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
12702# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12703
12704# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12705 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
12706# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12707
12708# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12709 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
12710# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12711
12712# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12713 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
12714# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12715
12716# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12717 if (chemistry) then
12718# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12719 eps = 0.001_wp
12720# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12721 call get_species_enthalpies_rt(t_l, h_il)
12722# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12723 call get_species_enthalpies_rt(t_r, h_ir)
12724# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12725 h_il = h_il*gas_constant/molecular_weights*t_l
12726# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12727 h_ir = h_ir*gas_constant/molecular_weights*t_r
12728# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12729 call get_species_specific_heats_r(t_l, cp_il)
12730# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12731 call get_species_specific_heats_r(t_r, cp_ir)
12732# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12733
12734# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12735 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
12736# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12737 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
12738# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12739 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
12740# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12741 if (abs(t_l - t_r) < eps) then
12742# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12743 ! Case when T_L and T_R are very close
12744# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12745 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
12746# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12747 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
12748# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12749 & - gas_constant/molecular_weights(:)))
12750# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12751 else
12752# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12753 ! Normal calculation when T_L and T_R are sufficiently different
12754# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12755 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
12756# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12757 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
12758# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12759 end if
12760# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12761 gamma_avg = cp_avg/cv_avg
12762# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12763
12764# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12765 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
12766# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12767 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
12768# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12769 end if
12770# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12771 end if
12772# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12773
12774# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12775 if (avg_state == 2) then
12776# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12777 rho_avg = 5.e-1_wp*(rho_l + rho_r)
12778# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12779 vel_avg_rms = 0._wp
12780# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12781
12782# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12783#if defined(MFC_OpenACC)
12784# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12785!$acc loop seq
12786# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12787#elif defined(MFC_OpenMP)
12788# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12789
12790# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12791#endif
12792# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12793 do i = 1, num_vels
12794# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12795 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
12796# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12797 end do
12798# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12799
12800# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12801 h_avg = 5.e-1_wp*(h_l + h_r)
12802# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12803 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
12804# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12805 qv_avg = 5.e-1_wp*(qv_l + qv_r)
12806# 1972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12807 end if
12808
12809 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
12810 & c_l, qv_l)
12811
12812 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
12813 & c_r, qv_r)
12814
12815 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
12816 ! variables are placeholders to call the subroutine.
12817 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
12818 & 0._wp, c_avg, qv_avg)
12819
12820 if (viscous) then
12821
12822# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12823#if defined(MFC_OpenACC)
12824# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12825!$acc loop seq
12826# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12827#elif defined(MFC_OpenMP)
12828# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12829
12830# 1986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12831#endif
12832 do i = 1, 2
12833 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
12834 end do
12835 end if
12836
12837 ! Low Mach correction
12838 if (low_mach == 2) then
12839 if (riemann_solver == 1 .or. riemann_solver == 5) then
12840# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12841 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12842# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12843 pcorr = 0._wp
12844# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12845
12846# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12847 if (low_mach == 1) then
12848# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12849 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12850# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12851 end if
12852# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12853 else if (riemann_solver == 2) then
12854# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12855 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12856# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12857 pcorr = 0._wp
12858# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12859
12860# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12861 if (low_mach == 1) then
12862# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12863 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
12864# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12865 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
12866# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12867 else if (low_mach == 2) then
12868# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12869 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
12870# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12871 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
12872# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12873 vel_l(dir_idx(1)) = vel_l_tmp
12874# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12875 vel_r(dir_idx(1)) = vel_r_tmp
12876# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12877 end if
12878# 1994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12879 end if
12880 end if
12881
12882 ! COMPUTING THE DIRECT WAVE SPEEDS
12883 if (wave_speeds == 1) then
12884 if (elasticity) then
12885 ! Elastic wave speed, Rodriguez et al. JCP (2019)
12886 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1) &
12887 & ))/rho_l), &
12888 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
12889 & + tau_e_r(dir_idx_tau(1)))/rho_r))
12890 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1) &
12891 & ))/rho_r), &
12892 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
12893 & + tau_e_l(dir_idx_tau(1)))/rho_l))
12894 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
12895 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
12896 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
12897 & - vel_r(dir_idx(1))))
12898 else
12899 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
12900 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
12901 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
12902 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
12903 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
12904 end if
12905 else if (wave_speeds == 2) then
12906 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
12907
12908 pres_sr = pres_sl
12909
12910 ! Low Mach correction: Thornber et al. JCP (2008)
12911 ms_l = max(1._wp, &
12912 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
12913 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
12914 ms_r = max(1._wp, &
12915 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
12916 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
12917
12918 s_l = vel_l(dir_idx(1)) - c_l*ms_l
12919 s_r = vel_r(dir_idx(1)) + c_r*ms_r
12920
12921 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
12922 end if
12923
12924 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
12925 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
12926
12927 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
12928 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
12929 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
12930
12931 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
12932 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
12933 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
12934
12935 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
12936 xi_mp = -min(0._wp, sign(1._wp, s_l))
12937 xi_pp = max(0._wp, sign(1._wp, s_r))
12938
12939 e_star = xi_m*(e_l + xi_mp*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l &
12940 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
12941 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
12942 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
12943 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
12944
12945 rho_star = xi_m*(rho_l*(xi_mp*xi_l + 1._wp - xi_mp)) + xi_p*(rho_r*(xi_pp*xi_r + 1._wp - xi_pp))
12946
12947 vel_k_star = vel_l(dir_idx(1))*(1._wp - xi_mp) + xi_mp*vel_r(dir_idx(1)) + xi_mp*xi_pp*(s_s &
12948 & - vel_r(dir_idx(1)))
12949
12950 ! Low Mach correction
12951 if (low_mach == 1) then
12952 if (riemann_solver == 1 .or. riemann_solver == 5) then
12953# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12954 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12955# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12956 pcorr = 0._wp
12957# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12958
12959# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12960 if (low_mach == 1) then
12961# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12962 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12963# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12964 end if
12965# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12966 else if (riemann_solver == 2) then
12967# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12968 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12969# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12970 pcorr = 0._wp
12971# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12972
12973# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12974 if (low_mach == 1) then
12975# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12976 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
12977# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12978 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
12979# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12980 else if (low_mach == 2) then
12981# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12982 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
12983# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12984 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
12985# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12986 vel_l(dir_idx(1)) = vel_l_tmp
12987# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12988 vel_r(dir_idx(1)) = vel_r_tmp
12989# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12990 end if
12991# 2067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12992 end if
12993 else
12994 pcorr = 0._wp
12995 end if
12996
12997 ! COMPUTING FLUXES MASS FLUX.
12998
12999# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13000#if defined(MFC_OpenACC)
13001# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13002!$acc loop seq
13003# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13004#elif defined(MFC_OpenMP)
13005# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13006
13007# 2073 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13008#endif
13009 do i = 1, eqn_idx%cont%end
13010 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
13011 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsz_vf(j &
13012 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13013 end do
13014
13015 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
13016
13017# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13018#if defined(MFC_OpenACC)
13019# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13020!$acc loop seq
13021# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13022#elif defined(MFC_OpenMP)
13023# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13024
13025# 2081 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13026#endif
13027 do i = 1, num_dims
13028 flux_rsz_vf(j, k, l, &
13029 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
13030 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
13031 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l) &
13032 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
13033 end do
13034
13035 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
13036 flux_rsz_vf(j, k, l, eqn_idx%E) = (e_star + p_star)*vel_k_star + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
13037
13038 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
13039 if (elasticity) then
13040 flux_ene_e = 0._wp
13041
13042# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13043#if defined(MFC_OpenACC)
13044# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13045!$acc loop seq
13046# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13047#elif defined(MFC_OpenMP)
13048# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13049
13050# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13051#endif
13052 do i = 1, num_dims
13053 ! MOMENTUM ELASTIC FLUX.
13054 flux_rsz_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsz_vf(j, k, l, &
13055 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
13056 & - xi_p*tau_e_r(dir_idx_tau(i))
13057 ! ENERGY ELASTIC FLUX.
13058 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
13059 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
13060 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
13061 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
13062 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
13063 end do
13064 flux_rsz_vf(j, k, l, eqn_idx%E) = flux_rsz_vf(j, k, l, eqn_idx%E) + flux_ene_e
13065 end if
13066
13067 ! VOLUME FRACTION FLUX.
13068
13069# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13070#if defined(MFC_OpenACC)
13071# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13072!$acc loop seq
13073# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13074#elif defined(MFC_OpenMP)
13075# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13076
13077# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13078#endif
13079 do i = eqn_idx%adv%beg, eqn_idx%adv%end
13080 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
13081 & i)*s_s + xi_p*qr_prim_rsz_vf(j + 1, k, l, i)*s_s
13082 end do
13083
13084 ! Advection velocity source: interface velocity for volume fraction transport
13085
13086# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13087#if defined(MFC_OpenACC)
13088# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13089!$acc loop seq
13090# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13091#elif defined(MFC_OpenMP)
13092# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13093
13094# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13095#endif
13096 do i = 1, num_dims
13097 vel_src_rsz_vf(j, k, l, &
13098 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
13099 & *(s_s*(xi_mp*(xi_l - 1) + 1) - vel_l(dir_idx(i)))) &
13100 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(s_s*(xi_pp*(xi_r - 1) &
13101 & + 1) - vel_r(dir_idx(i))))
13102 end do
13103
13104 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
13105 ! energy flux
13106
13107# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13108#if defined(MFC_OpenACC)
13109# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13110!$acc loop seq
13111# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13112#elif defined(MFC_OpenMP)
13113# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13114
13115# 2131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13116#endif
13117 do i = 1, num_fluids
13118 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
13119 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
13120 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
13121 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
13122 & + pres_r)
13123
13124 flux_rsz_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsz_vf(j, k, l, &
13125 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsz_vf(j + 1, k, l, &
13126 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
13127 & + (xi_m*ql_prim_rsz_vf(j, k, l, &
13128 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsz_vf(j + 1, k, l, &
13129 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
13130 & *pcorr*s_s*(xi_m*ql_prim_rsz_vf(j, k, l, &
13131 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsz_vf(j + 1, k, l, &
13132 & i + eqn_idx%adv%beg - 1))
13133 end do
13134
13135 flux_src_rsz_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsz_vf(j, k, l, dir_idx(1))
13136
13137 ! HYPOELASTIC STRESS EVOLUTION FLUX.
13138 if (hypoelasticity) then
13139
13140# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13141#if defined(MFC_OpenACC)
13142# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13143!$acc loop seq
13144# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13145#elif defined(MFC_OpenMP)
13146# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13147
13148# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13149#endif
13150 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
13151 flux_rsz_vf(j, k, l, &
13152 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s)) &
13153 & *(s_l*rho_l*tau_e_l(i) - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) &
13154 & + xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*tau_e_r(i) &
13155 & - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
13156 end do
13157 end if
13158
13159 ! Hyperelastic reference map flux for material deformation tracking
13160 if (hyperelasticity) then
13161
13162# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13163#if defined(MFC_OpenACC)
13164# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13165!$acc loop seq
13166# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13167#elif defined(MFC_OpenMP)
13168# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13169
13170# 2166 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13171#endif
13172 do i = 1, num_dims
13173 flux_rsz_vf(j, k, l, &
13174 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s)) &
13175 & *(s_l*rho_l*xi_field_l(i) - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) &
13176 & + xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
13177 & - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
13178 end do
13179 end if
13180
13181 ! COLOR FUNCTION FLUX
13182 if (surface_tension) then
13183 flux_rsz_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsz_vf(j, k, l, &
13184 & eqn_idx%c) + xi_p*qr_prim_rsz_vf(j + 1, k, l, eqn_idx%c))*s_s
13185 end if
13186
13187 ! Geometrical source flux for cylindrical coordinates
13188# 2205 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13189# 2206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13190 if (grid_geometry == 3) then
13191
13192# 2207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13193#if defined(MFC_OpenACC)
13194# 2207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13195!$acc loop seq
13196# 2207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13197#elif defined(MFC_OpenMP)
13198# 2207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13199
13200# 2207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13201#endif
13202 do i = 1, sys_size
13203 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
13204 end do
13205 flux_gsrc_rsz_vf(j, k, l, &
13206 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsz_vf(j, k, &
13207 & l, eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
13208
13209 flux_gsrc_rsz_vf(j, k, l, eqn_idx%mom%end) = flux_rsz_vf(j, k, l, &
13210 & eqn_idx%mom%beg + 1)
13211 end if
13212# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13213 end do
13214 end do
13215 end do
13216
13217# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13218#if defined(MFC_OpenACC)
13219# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13220!$acc end parallel loop
13221# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13222#elif defined(MFC_OpenMP)
13223# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13224
13225# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13226!$omp end target teams loop
13227# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13228#endif
13229 else if (model_eqns == 4) then
13230 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
13231
13232# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13233
13234# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13235#if defined(MFC_OpenACC)
13236# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13237!$acc parallel loop collapse(3) gang vector default(present) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
13238# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13239#elif defined(MFC_OpenMP)
13240# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13241
13242# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13243
13244# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13245
13246# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13247!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
13248# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13249#endif
13250# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13251 do l = is3%beg, is3%end
13252 do k = is2%beg, is2%end
13253 do j = is1%beg, is1%end
13254 vel_l_rms = 0._wp; vel_r_rms = 0._wp
13255 rho_l = 0._wp; rho_r = 0._wp
13256 gamma_l = 0._wp; gamma_r = 0._wp
13257 pi_inf_l = 0._wp; pi_inf_r = 0._wp
13258 qv_l = 0._wp; qv_r = 0._wp
13259
13260
13261# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13262#if defined(MFC_OpenACC)
13263# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13264!$acc loop seq
13265# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13266#elif defined(MFC_OpenMP)
13267# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13268
13269# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13270#endif
13271 do i = 1, eqn_idx%cont%end
13272 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
13273 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
13274 end do
13275
13276
13277# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13278#if defined(MFC_OpenACC)
13279# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13280!$acc loop seq
13281# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13282#elif defined(MFC_OpenMP)
13283# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13284
13285# 2249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13286#endif
13287 do i = 1, num_dims
13288 vel_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%cont%end + i)
13289 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%cont%end + i)
13290 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
13291 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
13292 end do
13293
13294
13295# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13296#if defined(MFC_OpenACC)
13297# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13298!$acc loop seq
13299# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13300#elif defined(MFC_OpenMP)
13301# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13302
13303# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13304#endif
13305 do i = 1, num_fluids
13306 alpha_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)
13307 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)
13308 end do
13309
13310# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13311#if defined(MFC_OpenACC)
13312# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13313!$acc loop seq
13314# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13315#elif defined(MFC_OpenMP)
13316# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13317
13318# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13319#endif
13320 do i = 1, num_fluids
13321 alpha_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)
13322 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)
13323 end do
13324
13325
13326# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13327#if defined(MFC_OpenACC)
13328# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13329!$acc loop seq
13330# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13331#elif defined(MFC_OpenMP)
13332# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13333
13334# 2268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13335#endif
13336 do i = 1, num_fluids
13337 rho_l = rho_l + alpha_rho_l(i)
13338 gamma_l = gamma_l + alpha_l(i)*gammas(i)
13339 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
13340 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
13341
13342 rho_r = rho_r + alpha_rho_r(i)
13343 gamma_r = gamma_r + alpha_r(i)*gammas(i)
13344 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
13345 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
13346 end do
13347
13348 pres_l = ql_prim_rsz_vf(j, k, l, eqn_idx%E)
13349 pres_r = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E)
13350
13351 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
13352 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
13353
13354 h_l = (e_l + pres_l)/rho_l
13355 h_r = (e_r + pres_r)/rho_r
13356
13357 if (avg_state == 1) then
13358# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13359 rho_avg = sqrt(rho_l*rho_r)
13360# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13361
13362# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13363 vel_avg_rms = 0._wp
13364# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13365
13366# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13367
13368# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13369#if defined(MFC_OpenACC)
13370# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13371!$acc loop seq
13372# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13373#elif defined(MFC_OpenMP)
13374# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13375
13376# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13377#endif
13378# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13379 do i = 1, num_vels
13380# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13381 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
13382# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13383 end do
13384# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13385
13386# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13387 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
13388# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13389
13390# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13391 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
13392# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13393
13394# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13395 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
13396# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13397
13398# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13399 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
13400# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13401
13402# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13403 if (chemistry) then
13404# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13405 eps = 0.001_wp
13406# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13407 call get_species_enthalpies_rt(t_l, h_il)
13408# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13409 call get_species_enthalpies_rt(t_r, h_ir)
13410# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13411 h_il = h_il*gas_constant/molecular_weights*t_l
13412# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13413 h_ir = h_ir*gas_constant/molecular_weights*t_r
13414# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13415 call get_species_specific_heats_r(t_l, cp_il)
13416# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13417 call get_species_specific_heats_r(t_r, cp_ir)
13418# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13419
13420# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13421 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
13422# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13423 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
13424# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13425 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
13426# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13427 if (abs(t_l - t_r) < eps) then
13428# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13429 ! Case when T_L and T_R are very close
13430# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13431 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
13432# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13433 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
13434# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13435 & - gas_constant/molecular_weights(:)))
13436# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13437 else
13438# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13439 ! Normal calculation when T_L and T_R are sufficiently different
13440# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13441 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
13442# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13443 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
13444# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13445 end if
13446# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13447 gamma_avg = cp_avg/cv_avg
13448# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13449
13450# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13451 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
13452# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13453 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
13454# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13455 end if
13456# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13457 end if
13458# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13459
13460# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13461 if (avg_state == 2) then
13462# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13463 rho_avg = 5.e-1_wp*(rho_l + rho_r)
13464# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13465 vel_avg_rms = 0._wp
13466# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13467
13468# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13469#if defined(MFC_OpenACC)
13470# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13471!$acc loop seq
13472# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13473#elif defined(MFC_OpenMP)
13474# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13475
13476# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13477#endif
13478# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13479 do i = 1, num_vels
13480# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13481 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
13482# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13483 end do
13484# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13485
13486# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13487 h_avg = 5.e-1_wp*(h_l + h_r)
13488# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13489 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
13490# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13491 qv_avg = 5.e-1_wp*(qv_l + qv_r)
13492# 2290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13493 end if
13494
13495 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
13496 & c_l, qv_l)
13497
13498 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
13499 & c_r, qv_r)
13500
13501 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
13502 ! variables are placeholders to call the subroutine.
13503
13504 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
13505 & 0._wp, c_avg, qv_avg)
13506
13507 if (wave_speeds == 1) then
13508 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
13509 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
13510
13511 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
13512 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
13513 & - rho_r*(s_r - vel_r(dir_idx(1))))
13514 else if (wave_speeds == 2) then
13515 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
13516
13517 pres_sr = pres_sl
13518
13519 ! Low Mach correction: Thornber et al. JCP (2008)
13520 ms_l = max(1._wp, &
13521 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
13522 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
13523 ms_r = max(1._wp, &
13524 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
13525 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
13526
13527 s_l = vel_l(dir_idx(1)) - c_l*ms_l
13528 s_r = vel_r(dir_idx(1)) + c_r*ms_r
13529
13530 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
13531 end if
13532
13533 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
13534 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
13535
13536 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
13537 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
13538 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
13539
13540 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
13541 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
13542 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
13543
13544
13545# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13546#if defined(MFC_OpenACC)
13547# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13548!$acc loop seq
13549# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13550#elif defined(MFC_OpenMP)
13551# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13552
13553# 2341 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13554#endif
13555 do i = 1, eqn_idx%cont%end
13556 flux_rsz_vf(j, k, l, &
13557 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
13558 & + xi_p*alpha_rho_r(i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13559 end do
13560
13561 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
13562
13563# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13564#if defined(MFC_OpenACC)
13565# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13566!$acc loop seq
13567# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13568#elif defined(MFC_OpenMP)
13569# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13570
13571# 2349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13572#endif
13573 do i = 1, num_dims
13574 flux_rsz_vf(j, k, l, &
13575 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
13576 & *vel_l(dir_idx(i)) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp &
13577 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) &
13578 & + dir_flg(dir_idx(i))*pres_l) + xi_p*(rho_r*(vel_r(dir_idx(1)) &
13579 & *vel_r(dir_idx(i)) + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp &
13580 & - dir_flg(dir_idx(i)))*vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) &
13581 & + dir_flg(dir_idx(i))*pres_r)
13582 end do
13583
13584 if (bubbles_euler) then
13585 ! Put p_tilde in
13586
13587# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13588#if defined(MFC_OpenACC)
13589# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13590!$acc loop seq
13591# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13592#elif defined(MFC_OpenMP)
13593# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13594
13595# 2363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13596#endif
13597 do i = 1, num_dims
13598 flux_rsz_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsz_vf(j, k, l, &
13599 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i)) &
13600 & *(-1._wp*ptilde_l)) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
13601 end do
13602 end if
13603
13604 flux_rsz_vf(j, k, l, eqn_idx%E) = 0._wp
13605
13606
13607# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13608#if defined(MFC_OpenACC)
13609# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13610!$acc loop seq
13611# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13612#elif defined(MFC_OpenMP)
13613# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13614
13615# 2373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13616#endif
13617 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
13618 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
13619 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsz_vf(j &
13620 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13621 end do
13622
13623 ! Advection velocity source: interface velocity for volume fraction transport
13624
13625# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13626#if defined(MFC_OpenACC)
13627# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13628!$acc loop seq
13629# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13630#elif defined(MFC_OpenMP)
13631# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13632
13633# 2381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13634#endif
13635 do i = 1, num_dims
13636 vel_src_rsz_vf(j, k, l, dir_idx(i)) = 0._wp
13637 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
13638 end do
13639
13640 flux_src_rsz_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsz_vf(j, k, l, dir_idx(1))
13641
13642 ! Add advection flux for bubble variables
13643 if (bubbles_euler) then
13644
13645# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13646#if defined(MFC_OpenACC)
13647# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13648!$acc loop seq
13649# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13650#elif defined(MFC_OpenMP)
13651# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13652
13653# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13654#endif
13655 do i = eqn_idx%bub%beg, eqn_idx%bub%end
13656 flux_rsz_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsz_vf(j, k, l, &
13657 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
13658 & + xi_p*nbub_r*qr_prim_rsz_vf(j + 1, k, l, &
13659 & i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13660 end do
13661 end if
13662
13663 ! Geometrical source flux for cylindrical coordinates
13664
13665# 2424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13666# 2425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13667 if (grid_geometry == 3) then
13668
13669# 2426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13670#if defined(MFC_OpenACC)
13671# 2426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13672!$acc loop seq
13673# 2426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13674#elif defined(MFC_OpenMP)
13675# 2426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13676
13677# 2426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13678#endif
13679 do i = 1, sys_size
13680 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
13681 end do
13682 flux_gsrc_rsz_vf(j, k, l, &
13683 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1)) &
13684 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
13685 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
13686 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
13687 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp &
13688 & - dir_flg(dir_idx(1)))*vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
13689 flux_gsrc_rsz_vf(j, k, l, eqn_idx%mom%end) = flux_rsz_vf(j, k, l, &
13690 & eqn_idx%mom%beg + 1)
13691 end if
13692# 2441 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13693 end do
13694 end do
13695 end do
13696
13697# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13698#if defined(MFC_OpenACC)
13699# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13700!$acc end parallel loop
13701# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13702#elif defined(MFC_OpenMP)
13703# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13704
13705# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13706!$omp end target teams loop
13707# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13708#endif
13709 else if (model_eqns == 2 .and. bubbles_euler) then
13710 ! 5-equation model with Euler-Euler bubble dynamics
13711
13712# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13713
13714# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13715#if defined(MFC_OpenACC)
13716# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13717!$acc parallel loop collapse(3) gang vector default(present) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
13718# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13719#elif defined(MFC_OpenMP)
13720# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13721
13722# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13723
13724# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13725
13726# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13727!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar, Ys_L, Ys_R, Cp_iL, Cp_iR, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2)
13728# 2447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13729#endif
13730# 2455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13731 do l = is3%beg, is3%end
13732 do k = is2%beg, is2%end
13733 do j = is1%beg, is1%end
13734 vel_l_rms = 0._wp; vel_r_rms = 0._wp
13735 rho_l = 0._wp; rho_r = 0._wp
13736 gamma_l = 0._wp; gamma_r = 0._wp
13737 pi_inf_l = 0._wp; pi_inf_r = 0._wp
13738 qv_l = 0._wp; qv_r = 0._wp
13739
13740
13741# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13742#if defined(MFC_OpenACC)
13743# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13744!$acc loop seq
13745# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13746#elif defined(MFC_OpenMP)
13747# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13748
13749# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13750#endif
13751 do i = 1, num_fluids
13752 alpha_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)
13753 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)
13754 end do
13755
13756 vel_l_rms = 0._wp; vel_r_rms = 0._wp
13757
13758
13759# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13760#if defined(MFC_OpenACC)
13761# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13762!$acc loop seq
13763# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13764#elif defined(MFC_OpenMP)
13765# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13766
13767# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13768#endif
13769 do i = 1, num_dims
13770 vel_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%cont%end + i)
13771 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%cont%end + i)
13772 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
13773 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
13774 end do
13775
13776 ! Retain this in the refactor
13777 if (mpp_lim .and. (num_fluids > 2)) then
13778
13779# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13780#if defined(MFC_OpenACC)
13781# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13782!$acc loop seq
13783# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13784#elif defined(MFC_OpenMP)
13785# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13786
13787# 2482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13788#endif
13789 do i = 1, num_fluids
13790 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
13791 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)*gammas(i)
13792 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
13793 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
13794 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
13795 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
13796 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
13797 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
13798 end do
13799 else if (num_fluids > 2) then
13800
13801# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13802#if defined(MFC_OpenACC)
13803# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13804!$acc loop seq
13805# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13806#elif defined(MFC_OpenMP)
13807# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13808
13809# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13810#endif
13811 do i = 1, num_fluids - 1
13812 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
13813 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)*gammas(i)
13814 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
13815 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
13816 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
13817 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
13818 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
13819 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
13820 end do
13821 else
13822 rho_l = ql_prim_rsz_vf(j, k, l, 1)
13823 gamma_l = gammas(1)
13824 pi_inf_l = pi_infs(1)
13825 qv_l = qvs(1)
13826 rho_r = qr_prim_rsz_vf(j + 1, k, l, 1)
13827 gamma_r = gammas(1)
13828 pi_inf_r = pi_infs(1)
13829 qv_r = qvs(1)
13830 end if
13831
13832 if (viscous) then
13833 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
13834
13835# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13836#if defined(MFC_OpenACC)
13837# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13838!$acc loop seq
13839# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13840#elif defined(MFC_OpenMP)
13841# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13842
13843# 2518 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13844#endif
13845 do i = 1, 2
13846 re_l(i) = dflt_real
13847 re_r(i) = dflt_real
13848
13849 if (re_size(i) > 0) re_l(i) = 0._wp
13850 if (re_size(i) > 0) re_r(i) = 0._wp
13851
13852
13853# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13854#if defined(MFC_OpenACC)
13855# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13856!$acc loop seq
13857# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13858#elif defined(MFC_OpenMP)
13859# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13860
13861# 2526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13862#endif
13863 do q = 1, re_size(i)
13864 re_l(i) = (1._wp - ql_prim_rsz_vf(j, k, l, eqn_idx%E + re_idx(i, &
13865 & q)))/res_gs(i, q) + re_l(i)
13866 re_r(i) = (1._wp - qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + re_idx(i, &
13867 & q)))/res_gs(i, q) + re_r(i)
13868 end do
13869
13870 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
13871 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
13872 end do
13873 end if
13874 end if
13875
13876 pres_l = ql_prim_rsz_vf(j, k, l, eqn_idx%E)
13877 pres_r = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E)
13878
13879 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
13880 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
13881
13882 h_l = (e_l + pres_l)/rho_l
13883 h_r = (e_r + pres_r)/rho_r
13884
13885 if (avg_state == 2) then
13886
13887# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13888#if defined(MFC_OpenACC)
13889# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13890!$acc loop seq
13891# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13892#elif defined(MFC_OpenMP)
13893# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13894
13895# 2550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13896#endif
13897 do i = 1, nb
13898 r0_l(i) = ql_prim_rsz_vf(j, k, l, rs(i))
13899 r0_r(i) = qr_prim_rsz_vf(j + 1, k, l, rs(i))
13900
13901 v0_l(i) = ql_prim_rsz_vf(j, k, l, vs(i))
13902 v0_r(i) = qr_prim_rsz_vf(j + 1, k, l, vs(i))
13903 if (.not. polytropic .and. .not. qbmm) then
13904 p0_l(i) = ql_prim_rsz_vf(j, k, l, ps(i))
13905 p0_r(i) = qr_prim_rsz_vf(j + 1, k, l, ps(i))
13906 end if
13907 end do
13908
13909 if (.not. qbmm) then
13910 if (adv_n) then
13911 nbub_l = ql_prim_rsz_vf(j, k, l, eqn_idx%n)
13912 nbub_r = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%n)
13913 else
13914 nbub_l = 0._wp
13915 nbub_r = 0._wp
13916
13917# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13918#if defined(MFC_OpenACC)
13919# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13920!$acc loop seq
13921# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13922#elif defined(MFC_OpenMP)
13923# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13924
13925# 2570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13926#endif
13927 do i = 1, nb
13928 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
13929 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
13930 end do
13931
13932 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsz_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
13933 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsz_vf(j + 1, k, l, &
13934 & eqn_idx%E + num_fluids)/nbub_r
13935 end if
13936 else
13937 ! nb stored in 0th moment of first R0 bin in variable conversion module
13938 nbub_l = ql_prim_rsz_vf(j, k, l, eqn_idx%bub%beg)
13939 nbub_r = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%bub%beg)
13940 end if
13941
13942
13943# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13944#if defined(MFC_OpenACC)
13945# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13946!$acc loop seq
13947# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13948#elif defined(MFC_OpenMP)
13949# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13950
13951# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13952#endif
13953 do i = 1, nb
13954 if (.not. qbmm) then
13955 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
13956 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
13957 end if
13958 end do
13959
13960 if (qbmm) then
13961 pbwr3lbar = mom_sp_rsz_vf(j, k, l, 4)
13962 pbwr3rbar = mom_sp_rsz_vf(j + 1, k, l, 4)
13963
13964 r3lbar = mom_sp_rsz_vf(j, k, l, 1)
13965 r3rbar = mom_sp_rsz_vf(j + 1, k, l, 1)
13966
13967 r3v2lbar = mom_sp_rsz_vf(j, k, l, 3)
13968 r3v2rbar = mom_sp_rsz_vf(j + 1, k, l, 3)
13969 else
13970 pbwr3lbar = 0._wp
13971 pbwr3rbar = 0._wp
13972
13973 r3lbar = 0._wp
13974 r3rbar = 0._wp
13975
13976 r3v2lbar = 0._wp
13977 r3v2rbar = 0._wp
13978
13979
13980# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13981#if defined(MFC_OpenACC)
13982# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13983!$acc loop seq
13984# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13985#elif defined(MFC_OpenMP)
13986# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13987
13988# 2613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13989#endif
13990 do i = 1, nb
13991 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
13992 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
13993
13994 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
13995 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
13996
13997 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
13998 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
13999 end do
14000 end if
14001
14002 rho_avg = 5.e-1_wp*(rho_l + rho_r)
14003 h_avg = 5.e-1_wp*(h_l + h_r)
14004 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
14005 qv_avg = 5.e-1_wp*(qv_l + qv_r)
14006 vel_avg_rms = 0._wp
14007
14008
14009# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14010#if defined(MFC_OpenACC)
14011# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14012!$acc loop seq
14013# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14014#elif defined(MFC_OpenMP)
14015# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14016
14017# 2632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14018#endif
14019 do i = 1, num_dims
14020 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
14021 end do
14022 end if
14023
14024 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
14025 & c_l, qv_l)
14026
14027 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
14028 & c_r, qv_r)
14029
14030 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
14031 ! variables are placeholders to call the subroutine.
14032 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
14033 & 0._wp, c_avg, qv_avg)
14034
14035 if (viscous) then
14036
14037# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14038#if defined(MFC_OpenACC)
14039# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14040!$acc loop seq
14041# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14042#elif defined(MFC_OpenMP)
14043# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14044
14045# 2650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14046#endif
14047 do i = 1, 2
14048 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
14049 end do
14050 end if
14051
14052 ! Low Mach correction
14053 if (low_mach == 2) then
14054 if (riemann_solver == 1 .or. riemann_solver == 5) then
14055# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14056 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14057# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14058 pcorr = 0._wp
14059# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14060
14061# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14062 if (low_mach == 1) then
14063# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14064 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14065# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14066 end if
14067# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14068 else if (riemann_solver == 2) then
14069# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14070 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14071# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14072 pcorr = 0._wp
14073# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14074
14075# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14076 if (low_mach == 1) then
14077# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14078 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
14079# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14080 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14081# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14082 else if (low_mach == 2) then
14083# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14084 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
14085# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14086 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
14087# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14088 vel_l(dir_idx(1)) = vel_l_tmp
14089# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14090 vel_r(dir_idx(1)) = vel_r_tmp
14091# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14092 end if
14093# 2658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14094 end if
14095 end if
14096
14097 if (wave_speeds == 1) then
14098 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
14099 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
14100
14101 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
14102 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
14103 & - rho_r*(s_r - vel_r(dir_idx(1))))
14104 else if (wave_speeds == 2) then
14105 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
14106
14107 pres_sr = pres_sl
14108
14109 ! Low Mach correction: Thornber et al. JCP (2008)
14110 ms_l = max(1._wp, &
14111 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
14112 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
14113 ms_r = max(1._wp, &
14114 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
14115 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
14116
14117 s_l = vel_l(dir_idx(1)) - c_l*ms_l
14118 s_r = vel_r(dir_idx(1)) + c_r*ms_r
14119
14120 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
14121 end if
14122
14123 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
14124 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
14125
14126 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
14127 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
14128 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
14129
14130 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
14131 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
14132 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
14133
14134 ! Low Mach correction
14135 if (low_mach == 1) then
14136 if (riemann_solver == 1 .or. riemann_solver == 5) then
14137# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14138 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14139# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14140 pcorr = 0._wp
14141# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14142
14143# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14144 if (low_mach == 1) then
14145# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14146 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14147# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14148 end if
14149# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14150 else if (riemann_solver == 2) then
14151# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14152 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14153# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14154 pcorr = 0._wp
14155# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14156
14157# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14158 if (low_mach == 1) then
14159# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14160 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
14161# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14162 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14163# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14164 else if (low_mach == 2) then
14165# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14166 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
14167# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14168 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
14169# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14170 vel_l(dir_idx(1)) = vel_l_tmp
14171# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14172 vel_r(dir_idx(1)) = vel_r_tmp
14173# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14174 end if
14175# 2700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14176 end if
14177 else
14178 pcorr = 0._wp
14179 end if
14180
14181
14182# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14183#if defined(MFC_OpenACC)
14184# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14185!$acc loop seq
14186# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14187#elif defined(MFC_OpenMP)
14188# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14189
14190# 2705 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14191#endif
14192 do i = 1, eqn_idx%cont%end
14193 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
14194 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsz_vf(j &
14195 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14196 end do
14197
14198 if (bubbles_euler .and. (num_fluids > 1)) then
14199 ! Kill mass transport @ gas density
14200 flux_rsz_vf(j, k, l, eqn_idx%cont%end) = 0._wp
14201 end if
14202
14203 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
14204
14205 ! Include p_tilde
14206
14207 if (avg_state == 2) then
14208 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
14209 pres_l = pres_l - alpha_l(num_fluids)*pres_l
14210 else
14211 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
14212 end if
14213
14214 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
14215 pres_r = pres_r - alpha_r(num_fluids)*pres_r
14216 else
14217 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
14218 end if
14219 end if
14220
14221
14222# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14223#if defined(MFC_OpenACC)
14224# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14225!$acc loop seq
14226# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14227#elif defined(MFC_OpenMP)
14228# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14229
14230# 2735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14231#endif
14232 do i = 1, num_dims
14233 flux_rsz_vf(j, k, l, &
14234 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
14235 & *vel_l(dir_idx(i)) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp &
14236 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) &
14237 & + dir_flg(dir_idx(i))*(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1)) &
14238 & *vel_r(dir_idx(i)) + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp &
14239 & - dir_flg(dir_idx(i)))*vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) &
14240 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i)) &
14241 & *pcorr
14242 end do
14243
14244 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
14245 flux_rsz_vf(j, k, l, &
14246 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
14247 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
14248 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s &
14249 & - vel_r(dir_idx(1)))*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) &
14250 & + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
14251
14252 ! Volume fraction flux
14253
14254# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14255#if defined(MFC_OpenACC)
14256# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14257!$acc loop seq
14258# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14259#elif defined(MFC_OpenMP)
14260# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14261
14262# 2757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14263#endif
14264 do i = eqn_idx%adv%beg, eqn_idx%adv%end
14265 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
14266 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsz_vf(j &
14267 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14268 end do
14269
14270 ! Advection velocity source: interface velocity for volume fraction transport
14271
14272# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14273#if defined(MFC_OpenACC)
14274# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14275!$acc loop seq
14276# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14277#elif defined(MFC_OpenMP)
14278# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14279
14280# 2765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14281#endif
14282 do i = 1, num_dims
14283 vel_src_rsz_vf(j, k, l, &
14284 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*(xi_l &
14285 & - 1._wp)) + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*(xi_r &
14286 & - 1._wp))
14287
14288 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
14289 end do
14290
14291 flux_src_rsz_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsz_vf(j, k, l, dir_idx(1))
14292
14293 ! Add advection flux for bubble variables
14294
14295# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14296#if defined(MFC_OpenACC)
14297# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14298!$acc loop seq
14299# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14300#elif defined(MFC_OpenMP)
14301# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14302
14303# 2778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14304#endif
14305 do i = eqn_idx%bub%beg, eqn_idx%bub%end
14306 flux_rsz_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsz_vf(j, k, l, &
14307 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
14308 & + xi_p*nbub_r*qr_prim_rsz_vf(j + 1, k, l, &
14309 & i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14310 end do
14311
14312 if (qbmm) then
14313 flux_rsz_vf(j, k, l, &
14314 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
14315 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14316 end if
14317
14318 if (adv_n) then
14319 flux_rsz_vf(j, k, l, &
14320 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
14321 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14322 end if
14323
14324 ! Geometrical source flux for cylindrical coordinates
14325# 2821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14326# 2822 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14327 if (grid_geometry == 3) then
14328
14329# 2823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14330#if defined(MFC_OpenACC)
14331# 2823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14332!$acc loop seq
14333# 2823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14334#elif defined(MFC_OpenMP)
14335# 2823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14336
14337# 2823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14338#endif
14339 do i = 1, sys_size
14340 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
14341 end do
14342
14343 flux_gsrc_rsz_vf(j, k, l, &
14344 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1)) &
14345 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
14346 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
14347 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
14348 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp &
14349 & - dir_flg(dir_idx(1)))*vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
14350 flux_gsrc_rsz_vf(j, k, l, eqn_idx%mom%end) = flux_rsz_vf(j, k, l, &
14351 & eqn_idx%mom%beg + 1)
14352 end if
14353# 2839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14354 end do
14355 end do
14356 end do
14357
14358# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14359#if defined(MFC_OpenACC)
14360# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14361!$acc end parallel loop
14362# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14363#elif defined(MFC_OpenMP)
14364# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14365
14366# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14367!$omp end target teams loop
14368# 2842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14369#endif
14370 else
14371 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
14372
14373# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14374
14375# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14376#if defined(MFC_OpenACC)
14377# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14378!$acc parallel loop collapse(3) gang vector default(present) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) copyin(is1, is2, is3)
14379# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14380#elif defined(MFC_OpenMP)
14381# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14382
14383# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14384
14385# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14386
14387# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14388!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) map(to:is1, is2, is3)
14389# 2845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14390#endif
14391# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14392 do l = is3%beg, is3%end
14393 do k = is2%beg, is2%end
14394 do j = is1%beg, is1%end
14395 vel_l_rms = 0._wp; vel_r_rms = 0._wp
14396 rho_l = 0._wp; rho_r = 0._wp
14397 gamma_l = 0._wp; gamma_r = 0._wp
14398 pi_inf_l = 0._wp; pi_inf_r = 0._wp
14399 qv_l = 0._wp; qv_r = 0._wp
14400 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
14401
14402
14403# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14404#if defined(MFC_OpenACC)
14405# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14406!$acc loop seq
14407# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14408#elif defined(MFC_OpenMP)
14409# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14410
14411# 2863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14412#endif
14413 do i = 1, num_fluids
14414 alpha_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)
14415 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)
14416 end do
14417
14418
14419# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14420#if defined(MFC_OpenACC)
14421# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14422!$acc loop seq
14423# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14424#elif defined(MFC_OpenMP)
14425# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14426
14427# 2869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14428#endif
14429 do i = 1, num_dims
14430 vel_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%cont%end + i)
14431 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%cont%end + i)
14432 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
14433 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
14434 end do
14435
14436 pres_l = ql_prim_rsz_vf(j, k, l, eqn_idx%E)
14437 pres_r = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E)
14438
14439 ! Change this by splitting it into the cases present in the bubbles_euler
14440 if (mpp_lim) then
14441
14442# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14443#if defined(MFC_OpenACC)
14444# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14445!$acc loop seq
14446# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14447#elif defined(MFC_OpenMP)
14448# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14449
14450# 2882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14451#endif
14452 do i = 1, num_fluids
14453 ql_prim_rsz_vf(j, k, l, i) = max(0._wp, ql_prim_rsz_vf(j, k, l, i))
14454 ql_prim_rsz_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsz_vf(j, k, &
14455 & l, eqn_idx%E + i)), 1._wp)
14456 qr_prim_rsz_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsz_vf(j + 1, k, l, i))
14457 qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
14458 & qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
14459 alpha_l_sum = alpha_l_sum + ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)
14460 alpha_r_sum = alpha_r_sum + qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)
14461 end do
14462
14463
14464# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14465#if defined(MFC_OpenACC)
14466# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14467!$acc loop seq
14468# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14469#elif defined(MFC_OpenMP)
14470# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14471
14472# 2894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14473#endif
14474 do i = 1, num_fluids
14475 ql_prim_rsz_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsz_vf(j, k, l, &
14476 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
14477 qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsz_vf(j + 1, k, l, &
14478 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
14479 end do
14480 end if
14481
14482
14483# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14484#if defined(MFC_OpenACC)
14485# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14486!$acc loop seq
14487# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14488#elif defined(MFC_OpenMP)
14489# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14490
14491# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14492#endif
14493 do i = 1, num_fluids
14494 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
14495 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)*gammas(i)
14496 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
14497 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
14498
14499 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
14500 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
14501 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
14502 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
14503 end do
14504
14505 re_max = 0
14506 if (re_size(1) > 0) re_max = 1
14507 if (re_size(2) > 0) re_max = 2
14508
14509 if (viscous) then
14510
14511# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14512#if defined(MFC_OpenACC)
14513# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14514!$acc loop seq
14515# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14516#elif defined(MFC_OpenMP)
14517# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14518
14519# 2921 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14520#endif
14521 do i = 1, re_max
14522 re_l(i) = 0._wp
14523 re_r(i) = 0._wp
14524
14525
14526# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14527#if defined(MFC_OpenACC)
14528# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14529!$acc loop seq
14530# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14531#elif defined(MFC_OpenMP)
14532# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14533
14534# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14535#endif
14536 do q = 1, re_size(i)
14537 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
14538 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
14539 end do
14540
14541 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
14542 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
14543 end do
14544 end if
14545
14546 if (chemistry) then
14547 c_sum_yi_phi = 0.0_wp
14548
14549# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14550#if defined(MFC_OpenACC)
14551# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14552!$acc loop seq
14553# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14554#elif defined(MFC_OpenMP)
14555# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14556
14557# 2939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14558#endif
14559 do i = eqn_idx%species%beg, eqn_idx%species%end
14560 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsz_vf(j, k, l, i)
14561 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsz_vf(j + 1, k, l, i)
14562 end do
14563
14564 call get_mixture_molecular_weight(ys_l, mw_l)
14565 call get_mixture_molecular_weight(ys_r, mw_r)
14566
14567# 2952 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14568 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
14569 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
14570# 2955 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14571
14572 r_gas_l = gas_constant/mw_l
14573 r_gas_r = gas_constant/mw_r
14574
14575 t_l = pres_l/rho_l/r_gas_l
14576 t_r = pres_r/rho_r/r_gas_r
14577
14578 call get_species_specific_heats_r(t_l, cp_il)
14579 call get_species_specific_heats_r(t_r, cp_ir)
14580
14581 if (chem_params%gamma_method == 1) then
14582 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
14583 gamma_il = cp_il/(cp_il - 1.0_wp)
14584 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
14585
14586 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
14587 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
14588 else if (chem_params%gamma_method == 2) then
14589 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
14590 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
14591 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
14592 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
14593 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
14594
14595 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
14596 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
14597 end if
14598
14599 call get_mixture_energy_mass(t_l, ys_l, e_l)
14600 call get_mixture_energy_mass(t_r, ys_r, e_r)
14601
14602 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
14603 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
14604 h_l = (e_l + pres_l)/rho_l
14605 h_r = (e_r + pres_r)/rho_r
14606 else
14607 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
14608 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
14609
14610 h_l = (e_l + pres_l)/rho_l
14611 h_r = (e_r + pres_r)/rho_r
14612 end if
14613
14614 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
14615 if (hypoelasticity) then
14616
14617# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14618#if defined(MFC_OpenACC)
14619# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14620!$acc loop seq
14621# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14622#elif defined(MFC_OpenMP)
14623# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14624
14625# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14626#endif
14627 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
14628 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
14629 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
14630 end do
14631 g_l = 0._wp
14632 g_r = 0._wp
14633
14634# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14635#if defined(MFC_OpenACC)
14636# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14637!$acc loop seq
14638# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14639#elif defined(MFC_OpenMP)
14640# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14641
14642# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14643#endif
14644 do i = 1, num_fluids
14645 g_l = g_l + alpha_l(i)*gs_rs(i)
14646 g_r = g_r + alpha_r(i)*gs_rs(i)
14647 end do
14648
14649# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14650#if defined(MFC_OpenACC)
14651# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14652!$acc loop seq
14653# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14654#elif defined(MFC_OpenMP)
14655# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14656
14657# 3012 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14658#endif
14659 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
14660 ! Elastic contribution to energy if G large enough
14661 if ((g_l > verysmall) .and. (g_r > verysmall)) then
14662 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
14663 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
14664 ! Additional terms in 2D and 3D
14665 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
14666 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
14667 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
14668 end if
14669 end if
14670 end do
14671 end if
14672
14673 ! Hyperelastic stress contribution: strain energy added to total energy
14674 if (hyperelasticity) then
14675
14676# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14677#if defined(MFC_OpenACC)
14678# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14679!$acc loop seq
14680# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14681#elif defined(MFC_OpenMP)
14682# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14683
14684# 3029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14685#endif
14686 do i = 1, num_dims
14687 xi_field_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
14688 xi_field_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
14689 end do
14690 g_l = 0._wp
14691 g_r = 0._wp
14692
14693# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14694#if defined(MFC_OpenACC)
14695# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14696!$acc loop seq
14697# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14698#elif defined(MFC_OpenMP)
14699# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14700
14701# 3036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14702#endif
14703 do i = 1, num_fluids
14704 ! Mixture left and right shear modulus
14705 g_l = g_l + alpha_l(i)*gs_rs(i)
14706 g_r = g_r + alpha_r(i)*gs_rs(i)
14707 end do
14708 ! Elastic contribution to energy if G large enough
14709 if (g_l > verysmall .and. g_r > verysmall) then
14710 e_l = e_l + g_l*ql_prim_rsz_vf(j, k, l, eqn_idx%xi%end + 1)
14711 e_r = e_r + g_r*qr_prim_rsz_vf(j + 1, k, l, eqn_idx%xi%end + 1)
14712 end if
14713
14714# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14715#if defined(MFC_OpenACC)
14716# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14717!$acc loop seq
14718# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14719#elif defined(MFC_OpenMP)
14720# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14721
14722# 3047 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14723#endif
14724 do i = 1, b_size - 1
14725 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
14726 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
14727 end do
14728 end if
14729
14730 h_l = (e_l + pres_l)/rho_l
14731 h_r = (e_r + pres_r)/rho_r
14732
14733 if (avg_state == 1) then
14734# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14735 rho_avg = sqrt(rho_l*rho_r)
14736# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14737
14738# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14739 vel_avg_rms = 0._wp
14740# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14741
14742# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14743
14744# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14745#if defined(MFC_OpenACC)
14746# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14747!$acc loop seq
14748# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14749#elif defined(MFC_OpenMP)
14750# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14751
14752# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14753#endif
14754# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14755 do i = 1, num_vels
14756# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14757 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
14758# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14759 end do
14760# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14761
14762# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14763 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
14764# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14765
14766# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14767 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
14768# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14769
14770# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14771 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/(sqrt(rho_l) + sqrt(rho_r))**2._wp
14772# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14773
14774# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14775 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
14776# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14777
14778# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14779 if (chemistry) then
14780# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14781 eps = 0.001_wp
14782# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14783 call get_species_enthalpies_rt(t_l, h_il)
14784# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14785 call get_species_enthalpies_rt(t_r, h_ir)
14786# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14787 h_il = h_il*gas_constant/molecular_weights*t_l
14788# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14789 h_ir = h_ir*gas_constant/molecular_weights*t_r
14790# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14791 call get_species_specific_heats_r(t_l, cp_il)
14792# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14793 call get_species_specific_heats_r(t_r, cp_ir)
14794# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14795
14796# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14797 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
14798# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14799 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
14800# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14801 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
14802# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14803 if (abs(t_l - t_r) < eps) then
14804# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14805 ! Case when T_L and T_R are very close
14806# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14807 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
14808# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14809 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
14810# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14811 & - gas_constant/molecular_weights(:)))
14812# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14813 else
14814# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14815 ! Normal calculation when T_L and T_R are sufficiently different
14816# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14817 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
14818# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14819 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
14820# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14821 end if
14822# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14823 gamma_avg = cp_avg/cv_avg
14824# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14825
14826# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14827 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
14828# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14829 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
14830# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14831 end if
14832# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14833 end if
14834# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14835
14836# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14837 if (avg_state == 2) then
14838# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14839 rho_avg = 5.e-1_wp*(rho_l + rho_r)
14840# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14841 vel_avg_rms = 0._wp
14842# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14843
14844# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14845#if defined(MFC_OpenACC)
14846# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14847!$acc loop seq
14848# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14849#elif defined(MFC_OpenMP)
14850# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14851
14852# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14853#endif
14854# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14855 do i = 1, num_vels
14856# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14857 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
14858# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14859 end do
14860# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14861
14862# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14863 h_avg = 5.e-1_wp*(h_l + h_r)
14864# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14865 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
14866# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14867 qv_avg = 5.e-1_wp*(qv_l + qv_r)
14868# 3057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14869 end if
14870
14871 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
14872 & c_l, qv_l)
14873
14874 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
14875 & c_r, qv_r)
14876
14877 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
14878 ! variables are placeholders to call the subroutine.
14879 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
14880 & c_sum_yi_phi, c_avg, qv_avg)
14881
14882 if (viscous) then
14883 if (chemistry) then
14884 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
14885 end if
14886
14887# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14888#if defined(MFC_OpenACC)
14889# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14890!$acc loop seq
14891# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14892#elif defined(MFC_OpenMP)
14893# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14894
14895# 3074 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14896#endif
14897 do i = 1, 2
14898 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
14899 end do
14900 end if
14901
14902 ! Low Mach correction
14903 if (low_mach == 2) then
14904 if (riemann_solver == 1 .or. riemann_solver == 5) then
14905# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14906 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14907# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14908 pcorr = 0._wp
14909# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14910
14911# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14912 if (low_mach == 1) then
14913# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14914 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14915# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14916 end if
14917# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14918 else if (riemann_solver == 2) then
14919# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14920 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14921# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14922 pcorr = 0._wp
14923# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14924
14925# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14926 if (low_mach == 1) then
14927# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14928 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
14929# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14930 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14931# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14932 else if (low_mach == 2) then
14933# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14934 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
14935# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14936 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
14937# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14938 vel_l(dir_idx(1)) = vel_l_tmp
14939# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14940 vel_r(dir_idx(1)) = vel_r_tmp
14941# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14942 end if
14943# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14944 end if
14945 end if
14946
14947 if (wave_speeds == 1) then
14948 if (elasticity) then
14949 ! Elastic wave speed, Rodriguez et al. JCP (2019)
14950 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1) &
14951 & ))/rho_l), &
14952 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
14953 & + tau_e_r(dir_idx_tau(1)))/rho_r))
14954 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1) &
14955 & ))/rho_r), &
14956 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
14957 & + tau_e_l(dir_idx_tau(1)))/rho_l))
14958 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
14959 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
14960 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
14961 & - vel_r(dir_idx(1))))
14962 else
14963 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
14964 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
14965 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
14966 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
14967 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
14968 end if
14969 else if (wave_speeds == 2) then
14970 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
14971
14972 pres_sr = pres_sl
14973
14974 ! Low Mach correction: Thornber et al. JCP (2008)
14975 ms_l = max(1._wp, &
14976 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
14977 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
14978 ms_r = max(1._wp, &
14979 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
14980 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
14981
14982 s_l = vel_l(dir_idx(1)) - c_l*ms_l
14983 s_r = vel_r(dir_idx(1)) + c_r*ms_r
14984
14985 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
14986 end if
14987
14988 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
14989 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
14990
14991 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
14992 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
14993 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
14994
14995 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
14996 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
14997 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
14998
14999 ! Low Mach correction
15000 if (low_mach == 1) then
15001 if (riemann_solver == 1 .or. riemann_solver == 5) then
15002# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15003 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
15004# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15005 pcorr = 0._wp
15006# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15007
15008# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15009 if (low_mach == 1) then
15010# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15011 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
15012# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15013 end if
15014# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15015 else if (riemann_solver == 2) then
15016# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15017 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
15018# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15019 pcorr = 0._wp
15020# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15021
15022# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15023 if (low_mach == 1) then
15024# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15025 pcorr = rho_l*rho_r*(s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))) &
15026# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15027 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
15028# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15029 else if (low_mach == 2) then
15030# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15031 vel_l_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
15032# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15033 vel_r_tmp = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + zcoef*(vel_r(dir_idx(1)) - vel_l(dir_idx(1))))
15034# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15035 vel_l(dir_idx(1)) = vel_l_tmp
15036# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15037 vel_r(dir_idx(1)) = vel_r_tmp
15038# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15039 end if
15040# 3139 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15041 end if
15042 else
15043 pcorr = 0._wp
15044 end if
15045
15046 ! COMPUTING THE HLLC FLUXES MASS FLUX.
15047
15048# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15049#if defined(MFC_OpenACC)
15050# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15051!$acc loop seq
15052# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15053#elif defined(MFC_OpenMP)
15054# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15055
15056# 3145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15057#endif
15058 do i = 1, eqn_idx%cont%end
15059 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
15060 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsz_vf(j &
15061 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15062 end do
15063
15064 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
15065
15066# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15067#if defined(MFC_OpenACC)
15068# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15069!$acc loop seq
15070# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15071#elif defined(MFC_OpenMP)
15072# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15073
15074# 3153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15075#endif
15076 do i = 1, num_dims
15077 flux_rsz_vf(j, k, l, &
15078 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
15079 & *vel_l(dir_idx(i)) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp &
15080 & - dir_flg(dir_idx(i)))*vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) &
15081 & + dir_flg(dir_idx(i))*(pres_l)) + xi_p*(rho_r*(vel_r(dir_idx(1)) &
15082 & *vel_r(dir_idx(i)) + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp &
15083 & - dir_flg(dir_idx(i)))*vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) &
15084 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i)) &
15085 & *pcorr
15086 end do
15087
15088 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
15089 flux_rsz_vf(j, k, l, &
15090 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
15091 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1))))) - e_l)) &
15092 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s &
15093 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r)) &
15094 & + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
15095
15096 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
15097 if (elasticity) then
15098 flux_ene_e = 0._wp
15099
15100# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15101#if defined(MFC_OpenACC)
15102# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15103!$acc loop seq
15104# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15105#elif defined(MFC_OpenMP)
15106# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15107
15108# 3177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15109#endif
15110 do i = 1, num_dims
15111 ! MOMENTUM ELASTIC FLUX.
15112 flux_rsz_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsz_vf(j, k, l, &
15113 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
15114 & - xi_p*tau_e_r(dir_idx_tau(i))
15115 ! ENERGY ELASTIC FLUX.
15116 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
15117 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
15118 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
15119 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
15120 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
15121 end do
15122 flux_rsz_vf(j, k, l, eqn_idx%E) = flux_rsz_vf(j, k, l, eqn_idx%E) + flux_ene_e
15123 end if
15124
15125 ! HYPOELASTIC STRESS EVOLUTION FLUX.
15126 if (hypoelasticity) then
15127
15128# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15129#if defined(MFC_OpenACC)
15130# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15131!$acc loop seq
15132# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15133#elif defined(MFC_OpenMP)
15134# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15135
15136# 3195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15137#endif
15138 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
15139 flux_rsz_vf(j, k, l, &
15140 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s)) &
15141 & *(s_l*rho_l*tau_e_l(i) - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) &
15142 & + xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*tau_e_r(i) &
15143 & - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
15144 end do
15145 end if
15146
15147 ! VOLUME FRACTION FLUX.
15148
15149# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15150#if defined(MFC_OpenACC)
15151# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15152!$acc loop seq
15153# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15154#elif defined(MFC_OpenMP)
15155# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15156
15157# 3206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15158#endif
15159 do i = eqn_idx%adv%beg, eqn_idx%adv%end
15160 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
15161 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsz_vf(j &
15162 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15163 end do
15164
15165 ! VOLUME FRACTION SOURCE FLUX.
15166
15167# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15168#if defined(MFC_OpenACC)
15169# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15170!$acc loop seq
15171# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15172#elif defined(MFC_OpenMP)
15173# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15174
15175# 3214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15176#endif
15177 do i = 1, num_dims
15178 vel_src_rsz_vf(j, k, l, &
15179 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*(xi_l &
15180 & - 1._wp)) + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*(xi_r &
15181 & - 1._wp))
15182 end do
15183
15184 ! COLOR FUNCTION FLUX
15185 if (surface_tension) then
15186 flux_rsz_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsz_vf(j, k, l, &
15187 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15188 & + xi_p*qr_prim_rsz_vf(j + 1, k, l, &
15189 & eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15190 end if
15191
15192 ! Hyperelastic reference map flux for material deformation tracking
15193 if (hyperelasticity) then
15194
15195# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15196#if defined(MFC_OpenACC)
15197# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15198!$acc loop seq
15199# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15200#elif defined(MFC_OpenMP)
15201# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15202
15203# 3232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15204#endif
15205 do i = 1, num_dims
15206 flux_rsz_vf(j, k, l, &
15207 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s)) &
15208 & *(s_l*rho_l*xi_field_l(i) - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) &
15209 & + xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
15210 & - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
15211 end do
15212 end if
15213
15214 flux_src_rsz_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsz_vf(j, k, l, dir_idx(1))
15215
15216 if (chemistry) then
15217
15218# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15219#if defined(MFC_OpenACC)
15220# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15221!$acc loop seq
15222# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15223#elif defined(MFC_OpenMP)
15224# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15225
15226# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15227#endif
15228 do i = eqn_idx%species%beg, eqn_idx%species%end
15229 y_l = ql_prim_rsz_vf(j, k, l, i)
15230 y_r = qr_prim_rsz_vf(j + 1, k, l, i)
15231
15232 flux_rsz_vf(j, k, l, &
15233 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15234 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15235 flux_src_rsz_vf(j, k, l, i) = 0.0_wp
15236 end do
15237 end if
15238
15239 ! Geometrical source flux for cylindrical coordinates
15240# 3280 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15241# 3281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15242 if (grid_geometry == 3) then
15243
15244# 3282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15245#if defined(MFC_OpenACC)
15246# 3282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15247!$acc loop seq
15248# 3282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15249#elif defined(MFC_OpenMP)
15250# 3282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15251
15252# 3282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15253#endif
15254 do i = 1, sys_size
15255 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
15256 end do
15257
15258 flux_gsrc_rsz_vf(j, k, l, &
15259 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1)) &
15260 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
15261 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
15262 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
15263 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp &
15264 & - dir_flg(dir_idx(1)))*vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
15265 flux_gsrc_rsz_vf(j, k, l, eqn_idx%mom%end) = flux_rsz_vf(j, k, l, &
15266 & eqn_idx%mom%beg + 1)
15267 end if
15268# 3298 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15269 end do
15270 end do
15271 end do
15272
15273# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15274#if defined(MFC_OpenACC)
15275# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15276!$acc end parallel loop
15277# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15278#elif defined(MFC_OpenMP)
15279# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15280
15281# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15282!$omp end target teams loop
15283# 3301 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15284#endif
15285 end if
15286 end if
15287# 3305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15288 ! Computing HLLC flux and source flux for Euler system of equations
15289
15290 if (viscous .or. dummy) then
15291 if (weno_re_flux) then
15292 call s_compute_viscous_source_flux(ql_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15293 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15294 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15295 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15296 & qr_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15297 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15298 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15299 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, &
15300 & iy, iz)
15301 else
15302 call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15303 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15304 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15305 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15306 & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15307 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15308 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15309 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, &
15310 & iy, iz)
15311 end if
15312 end if
15313
15314 if (surface_tension) then
15315 call s_compute_capillary_source_flux(vel_src_rsx_vf, vel_src_rsy_vf, vel_src_rsz_vf, flux_src_vf, norm_dir, isx, isy, &
15316 & isz)
15317 end if
15318
15319 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
15320
15321 end subroutine s_hllc_riemann_solver
15322
15323 !> HLLD Riemann solver for MHD, Miyoshi & Kusano JCP (2005)
15324 subroutine s_hlld_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, &
15325
15326 & dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, &
15327 & dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
15328
15329 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, ql_prim_rsy_vf, &
15330 & qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf
15331
15332 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
15333 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
15334
15335 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
15336 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
15337 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
15338 integer, intent(in) :: norm_dir
15339 type(int_bounds_info), intent(in) :: ix, iy, iz
15340
15341 ! Local variables:
15342
15343# 3363 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15344 real(wp), dimension(num_fluids) :: alpha_l, alpha_r, alpha_rho_l, alpha_rho_r
15345# 3365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15346 type(riemann_states_vec3) :: vel
15347 type(riemann_states) :: rho, pres, e, h_no_mag
15348 type(riemann_states) :: gamma, pi_inf, qv
15349 type(riemann_states) :: vel_rms
15350 type(riemann_states_vec3) :: b
15351 type(riemann_states) :: c, c_fast, pres_mag
15352
15353 ! HLLD speeds and intermediate state variables:
15354 real(wp) :: s_l, s_r, s_m, s_starl, s_starr
15355 real(wp) :: ptot_l, ptot_r, p_star, rhol_star, rhor_star, e_starl, e_starr
15356 real(wp), dimension(7) :: u_l, u_r, u_starl, u_starr, u_doublel, u_doubler
15357 real(wp), dimension(7) :: f_l, f_r, f_starl, f_starr, f_hlld
15358
15359 ! Indices for U and F: (rho, rho*vel(1), rho*vel(2), rho*vel(3), By, Bz, E) Note: vel and B are permutated, so vel(1) is the
15360 ! normal velocity, and x is the normal direction Note: Bx is omitted as the magnetic flux is always zero in the normal
15361 ! direction
15362
15363 real(wp) :: sqrt_rhol_star, sqrt_rhor_star, denom_ds, sign_bx
15364 real(wp) :: vl_star, vr_star, wl_star, wr_star
15365 real(wp) :: v_double, w_double, by_double, bz_double, e_doublel, e_doubler, e_double
15366 integer :: i, j, k, l
15367
15368 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
15369 & dql_prim_dy_vf, dql_prim_dz_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, &
15370 & dqr_prim_dz_vf, norm_dir, ix, iy, iz)
15371
15372 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
15373
15374# 3394 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15375 if (norm_dir == 1) then
15376
15377# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15378
15379# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15380#if defined(MFC_OpenACC)
15381# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15382!$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel, alpha_L, alpha_R, rho, pres, E, H_no_mag, gamma, pi_inf, qv, vel_rms, B, c, c_fast, pres_mag, U_L, U_R, U_starL, U_starR, U_doubleL, U_doubleR, F_L, F_R, F_starL, F_starR, F_hlld, s_L, s_R, s_M, s_starL, s_starR, pTot_L, pTot_R, p_star, rhoL_star, rhoR_star, E_starL, E_starR, sqrt_rhoL_star, sqrt_rhoR_star, denom_ds, sign_Bx, vL_star, vR_star, wL_star, wR_star, v_double, w_double, By_double, Bz_double, E_doubleL, E_doubleR, E_double) copyin(norm_dir)
15383# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15384#elif defined(MFC_OpenMP)
15385# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15386
15387# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15388
15389# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15390
15391# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15392!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(alpha_rho_L, alpha_rho_R, vel, alpha_L, alpha_R, rho, pres, E, H_no_mag, gamma, pi_inf, qv, vel_rms, B, c, c_fast, pres_mag, U_L, U_R, U_starL, U_starR, U_doubleL, U_doubleR, F_L, F_R, F_starL, F_starR, F_hlld, s_L, s_R, s_M, s_starL, s_starR, pTot_L, pTot_R, p_star, rhoL_star, rhoR_star, E_starL, E_starR, sqrt_rhoL_star, sqrt_rhoR_star, denom_ds, sign_Bx, vL_star, vR_star, wL_star, wR_star, v_double, w_double, By_double, Bz_double, E_doubleL, E_doubleR, E_double) map(to:norm_dir)
15393# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15394#endif
15395# 3401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15396 do l = is3%beg, is3%end
15397 do k = is2%beg, is2%end
15398 do j = is1%beg, is1%end
15399 ! (1) Extract the left/right primitive states
15400 do i = 1, eqn_idx%cont%end
15401 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
15402 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
15403 end do
15404
15405 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
15406 do i = 1, num_vels
15407 vel%L(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i))
15408 vel%R(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + dir_idx(i))
15409 end do
15410
15411 vel_rms%L = sum(vel%L**2._wp)
15412 vel_rms%R = sum(vel%R**2._wp)
15413
15414 do i = 1, num_fluids
15415 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
15416 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
15417 end do
15418
15419 pres%L = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
15420 pres%R = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
15421
15422 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
15423 if (mhd) then
15424 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
15425 b%L = [bx0, ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg), ql_prim_rsx_vf(j, k, l, &
15426 & eqn_idx%B%beg + 1)]
15427 b%R = [bx0, qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg), qr_prim_rsx_vf(j + 1, k, &
15428 & l, eqn_idx%B%beg + 1)]
15429 else ! 2D/3D: Bx, By, Bz as variables
15430 b%L = [ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1), ql_prim_rsx_vf(j, &
15431 & k, l, eqn_idx%B%beg + dir_idx(2) - 1), ql_prim_rsx_vf(j, &
15432 & k, l, eqn_idx%B%beg + dir_idx(3) - 1)]
15433 b%R = [qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + dir_idx(1) - 1), &
15434 & qr_prim_rsx_vf(j + 1, k, l, &
15435 & eqn_idx%B%beg + dir_idx(2) - 1), qr_prim_rsx_vf(j + 1, k, &
15436 & l, eqn_idx%B%beg + dir_idx(3) - 1)]
15437 end if
15438 end if
15439
15440 ! Sum properties of all fluid components
15441 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
15442 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
15443
15444# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15445#if defined(MFC_OpenACC)
15446# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15447!$acc loop seq
15448# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15449#elif defined(MFC_OpenMP)
15450# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15451
15452# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15453#endif
15454 do i = 1, num_fluids
15455 rho%L = rho%L + alpha_rho_l(i)
15456 gamma%L = gamma%L + alpha_l(i)*gammas(i)
15457 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
15458 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
15459
15460 rho%R = rho%R + alpha_rho_r(i)
15461 gamma%R = gamma%R + alpha_r(i)*gammas(i)
15462 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
15463 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
15464 end do
15465
15466 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
15467 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
15468 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
15469 e%R = gamma%R*pres%R + pi_inf%R + 0.5_wp*rho%R*vel_rms%R + qv%R + pres_mag%R ! includes magnetic energy
15470 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
15471 h_no_mag%R = (e%R + pres%R - pres_mag%R) &
15472 & /rho%R ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
15473
15474 ! (2) Compute fast wave speeds
15475 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, &
15476 & 0._wp, c%L, qv%L)
15477 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, &
15478 & 0._wp, c%R, qv%R)
15479 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
15480 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
15481
15482 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
15483 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
15484 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
15485
15486 ptot_l = pres%L + pres_mag%L
15487 ptot_r = pres%R + pres_mag%R
15488
15489 s_m = (((s_r - vel%R(1))*rho%R*vel%R(1) - (s_l - vel%L(1))*rho%L*vel%L(1) - ptot_r + ptot_l)/((s_r &
15490 & - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
15491
15492 ! (4) Compute star state variables
15493 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
15494 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
15495 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
15496 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
15497 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
15498
15499 ! (5) Compute left/right state vectors and fluxes
15500 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
15501 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
15502 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
15503 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
15504
15505 ! Compute the left/right fluxes
15506 f_l(1) = u_l(2)
15507 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
15508 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
15509 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
15510 f_l(7) = (e%L + ptot_l)*vel%L(1) - b%L(1)*(vel%L(1)*b%L(1) + vel%L(2)*b%L(2) + vel%L(3)*b%L(3))
15511
15512 f_r(1) = u_r(2)
15513 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
15514 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
15515 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
15516 f_r(7) = (e%R + ptot_r)*vel%R(1) - b%R(1)*(vel%R(1)*b%R(1) + vel%R(2)*b%R(2) + vel%R(3)*b%R(3))
15517 ! HLLD star-state fluxes via HLL jump relation
15518 f_starl = f_l + s_l*(u_starl - u_l)
15519 f_starr = f_r + s_r*(u_starr - u_r)
15520 ! Alfven wave speeds bounding the rotational discontinuities
15521 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
15522 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
15523 ! HLLD double-star (intermediate) states across rotational discontinuities
15524 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
15525 vl_star = vel%L(2); wl_star = vel%L(3)
15526 vr_star = vel%R(2); wr_star = vel%R(3)
15527
15528 ! (6) Compute the double-star states [Miyoshi Eqns. (59)-(62)]
15529 denom_ds = sqrt_rhol_star + sqrt_rhor_star
15530 sign_bx = sign(1._wp, b%L(1))
15531 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
15532 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
15533 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star &
15534 & - vl_star)*sign_bx)/denom_ds
15535 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star &
15536 & - wl_star)*sign_bx)/denom_ds
15537
15538 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double &
15539 & + w_double*bz_double))*sign_bx
15540 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double &
15541 & + w_double*bz_double))*sign_bx
15542 e_double = 0.5_wp*(e_doublel + e_doubler)
15543
15544 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, &
15545 & e_double]
15546 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, &
15547 & e_double]
15548
15549 ! Select HLLD flux region
15550 if (0.0_wp <= s_l) then
15551 f_hlld = f_l
15552 else if (0.0_wp <= s_starl) then
15553 f_hlld = f_l + s_l*(u_starl - u_l)
15554 else if (0.0_wp <= s_m) then
15555 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
15556 else if (0.0_wp <= s_starr) then
15557 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
15558 else if (0.0_wp <= s_r) then
15559 f_hlld = f_r + s_r*(u_starr - u_r)
15560 else
15561 f_hlld = f_r
15562 end if
15563
15564 ! (12) Write HLLD flux to output arrays
15565 flux_rsx_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
15566 ! Momentum
15567 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(2)
15568 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(3)
15569 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(4)
15570 ! Magnetic field
15571 if (n == 0) then
15572 flux_rsx_vf(j, k, l, eqn_idx%B%beg) = f_hlld(5)
15573 flux_rsx_vf(j, k, l, eqn_idx%B%beg + 1) = f_hlld(6)
15574 else
15575 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(2) - 1) = f_hlld(5)
15576 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(3) - 1) = f_hlld(6)
15577 end if
15578 ! Energy
15579 flux_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(7)
15580 ! Volume fractions
15581
15582# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15583#if defined(MFC_OpenACC)
15584# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15585!$acc loop seq
15586# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15587#elif defined(MFC_OpenMP)
15588# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15589
15590# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15591#endif
15592 do i = eqn_idx%adv%beg, eqn_idx%adv%end
15593 flux_rsx_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
15594 end do
15595
15596 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
15597 end do
15598 end do
15599 end do
15600
15601# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15602#if defined(MFC_OpenACC)
15603# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15604!$acc end parallel loop
15605# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15606#elif defined(MFC_OpenMP)
15607# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15608
15609# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15610!$omp end target teams loop
15611# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15612#endif
15613 end if
15614# 3394 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15615 if (norm_dir == 2) then
15616
15617# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15618
15619# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15620#if defined(MFC_OpenACC)
15621# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15622!$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel, alpha_L, alpha_R, rho, pres, E, H_no_mag, gamma, pi_inf, qv, vel_rms, B, c, c_fast, pres_mag, U_L, U_R, U_starL, U_starR, U_doubleL, U_doubleR, F_L, F_R, F_starL, F_starR, F_hlld, s_L, s_R, s_M, s_starL, s_starR, pTot_L, pTot_R, p_star, rhoL_star, rhoR_star, E_starL, E_starR, sqrt_rhoL_star, sqrt_rhoR_star, denom_ds, sign_Bx, vL_star, vR_star, wL_star, wR_star, v_double, w_double, By_double, Bz_double, E_doubleL, E_doubleR, E_double) copyin(norm_dir)
15623# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15624#elif defined(MFC_OpenMP)
15625# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15626
15627# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15628
15629# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15630
15631# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15632!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(alpha_rho_L, alpha_rho_R, vel, alpha_L, alpha_R, rho, pres, E, H_no_mag, gamma, pi_inf, qv, vel_rms, B, c, c_fast, pres_mag, U_L, U_R, U_starL, U_starR, U_doubleL, U_doubleR, F_L, F_R, F_starL, F_starR, F_hlld, s_L, s_R, s_M, s_starL, s_starR, pTot_L, pTot_R, p_star, rhoL_star, rhoR_star, E_starL, E_starR, sqrt_rhoL_star, sqrt_rhoR_star, denom_ds, sign_Bx, vL_star, vR_star, wL_star, wR_star, v_double, w_double, By_double, Bz_double, E_doubleL, E_doubleR, E_double) map(to:norm_dir)
15633# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15634#endif
15635# 3401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15636 do l = is3%beg, is3%end
15637 do k = is2%beg, is2%end
15638 do j = is1%beg, is1%end
15639 ! (1) Extract the left/right primitive states
15640 do i = 1, eqn_idx%cont%end
15641 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
15642 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
15643 end do
15644
15645 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
15646 do i = 1, num_vels
15647 vel%L(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%cont%end + dir_idx(i))
15648 vel%R(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%cont%end + dir_idx(i))
15649 end do
15650
15651 vel_rms%L = sum(vel%L**2._wp)
15652 vel_rms%R = sum(vel%R**2._wp)
15653
15654 do i = 1, num_fluids
15655 alpha_l(i) = ql_prim_rsy_vf(j, k, l, eqn_idx%E + i)
15656 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E + i)
15657 end do
15658
15659 pres%L = ql_prim_rsy_vf(j, k, l, eqn_idx%E)
15660 pres%R = qr_prim_rsy_vf(j + 1, k, l, eqn_idx%E)
15661
15662 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
15663 if (mhd) then
15664 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
15665 b%L = [bx0, ql_prim_rsy_vf(j, k, l, eqn_idx%B%beg), ql_prim_rsy_vf(j, k, l, &
15666 & eqn_idx%B%beg + 1)]
15667 b%R = [bx0, qr_prim_rsy_vf(j + 1, k, l, eqn_idx%B%beg), qr_prim_rsy_vf(j + 1, k, &
15668 & l, eqn_idx%B%beg + 1)]
15669 else ! 2D/3D: Bx, By, Bz as variables
15670 b%L = [ql_prim_rsy_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1), ql_prim_rsy_vf(j, &
15671 & k, l, eqn_idx%B%beg + dir_idx(2) - 1), ql_prim_rsy_vf(j, &
15672 & k, l, eqn_idx%B%beg + dir_idx(3) - 1)]
15673 b%R = [qr_prim_rsy_vf(j + 1, k, l, eqn_idx%B%beg + dir_idx(1) - 1), &
15674 & qr_prim_rsy_vf(j + 1, k, l, &
15675 & eqn_idx%B%beg + dir_idx(2) - 1), qr_prim_rsy_vf(j + 1, k, &
15676 & l, eqn_idx%B%beg + dir_idx(3) - 1)]
15677 end if
15678 end if
15679
15680 ! Sum properties of all fluid components
15681 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
15682 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
15683
15684# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15685#if defined(MFC_OpenACC)
15686# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15687!$acc loop seq
15688# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15689#elif defined(MFC_OpenMP)
15690# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15691
15692# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15693#endif
15694 do i = 1, num_fluids
15695 rho%L = rho%L + alpha_rho_l(i)
15696 gamma%L = gamma%L + alpha_l(i)*gammas(i)
15697 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
15698 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
15699
15700 rho%R = rho%R + alpha_rho_r(i)
15701 gamma%R = gamma%R + alpha_r(i)*gammas(i)
15702 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
15703 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
15704 end do
15705
15706 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
15707 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
15708 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
15709 e%R = gamma%R*pres%R + pi_inf%R + 0.5_wp*rho%R*vel_rms%R + qv%R + pres_mag%R ! includes magnetic energy
15710 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
15711 h_no_mag%R = (e%R + pres%R - pres_mag%R) &
15712 & /rho%R ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
15713
15714 ! (2) Compute fast wave speeds
15715 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, &
15716 & 0._wp, c%L, qv%L)
15717 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, &
15718 & 0._wp, c%R, qv%R)
15719 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
15720 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
15721
15722 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
15723 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
15724 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
15725
15726 ptot_l = pres%L + pres_mag%L
15727 ptot_r = pres%R + pres_mag%R
15728
15729 s_m = (((s_r - vel%R(1))*rho%R*vel%R(1) - (s_l - vel%L(1))*rho%L*vel%L(1) - ptot_r + ptot_l)/((s_r &
15730 & - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
15731
15732 ! (4) Compute star state variables
15733 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
15734 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
15735 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
15736 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
15737 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
15738
15739 ! (5) Compute left/right state vectors and fluxes
15740 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
15741 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
15742 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
15743 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
15744
15745 ! Compute the left/right fluxes
15746 f_l(1) = u_l(2)
15747 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
15748 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
15749 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
15750 f_l(7) = (e%L + ptot_l)*vel%L(1) - b%L(1)*(vel%L(1)*b%L(1) + vel%L(2)*b%L(2) + vel%L(3)*b%L(3))
15751
15752 f_r(1) = u_r(2)
15753 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
15754 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
15755 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
15756 f_r(7) = (e%R + ptot_r)*vel%R(1) - b%R(1)*(vel%R(1)*b%R(1) + vel%R(2)*b%R(2) + vel%R(3)*b%R(3))
15757 ! HLLD star-state fluxes via HLL jump relation
15758 f_starl = f_l + s_l*(u_starl - u_l)
15759 f_starr = f_r + s_r*(u_starr - u_r)
15760 ! Alfven wave speeds bounding the rotational discontinuities
15761 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
15762 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
15763 ! HLLD double-star (intermediate) states across rotational discontinuities
15764 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
15765 vl_star = vel%L(2); wl_star = vel%L(3)
15766 vr_star = vel%R(2); wr_star = vel%R(3)
15767
15768 ! (6) Compute the double-star states [Miyoshi Eqns. (59)-(62)]
15769 denom_ds = sqrt_rhol_star + sqrt_rhor_star
15770 sign_bx = sign(1._wp, b%L(1))
15771 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
15772 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
15773 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star &
15774 & - vl_star)*sign_bx)/denom_ds
15775 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star &
15776 & - wl_star)*sign_bx)/denom_ds
15777
15778 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double &
15779 & + w_double*bz_double))*sign_bx
15780 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double &
15781 & + w_double*bz_double))*sign_bx
15782 e_double = 0.5_wp*(e_doublel + e_doubler)
15783
15784 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, &
15785 & e_double]
15786 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, &
15787 & e_double]
15788
15789 ! Select HLLD flux region
15790 if (0.0_wp <= s_l) then
15791 f_hlld = f_l
15792 else if (0.0_wp <= s_starl) then
15793 f_hlld = f_l + s_l*(u_starl - u_l)
15794 else if (0.0_wp <= s_m) then
15795 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
15796 else if (0.0_wp <= s_starr) then
15797 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
15798 else if (0.0_wp <= s_r) then
15799 f_hlld = f_r + s_r*(u_starr - u_r)
15800 else
15801 f_hlld = f_r
15802 end if
15803
15804 ! (12) Write HLLD flux to output arrays
15805 flux_rsy_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
15806 ! Momentum
15807 flux_rsy_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(2)
15808 flux_rsy_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(3)
15809 flux_rsy_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(4)
15810 ! Magnetic field
15811 if (n == 0) then
15812 flux_rsy_vf(j, k, l, eqn_idx%B%beg) = f_hlld(5)
15813 flux_rsy_vf(j, k, l, eqn_idx%B%beg + 1) = f_hlld(6)
15814 else
15815 flux_rsy_vf(j, k, l, eqn_idx%B%beg + dir_idx(2) - 1) = f_hlld(5)
15816 flux_rsy_vf(j, k, l, eqn_idx%B%beg + dir_idx(3) - 1) = f_hlld(6)
15817 end if
15818 ! Energy
15819 flux_rsy_vf(j, k, l, eqn_idx%E) = f_hlld(7)
15820 ! Volume fractions
15821
15822# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15823#if defined(MFC_OpenACC)
15824# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15825!$acc loop seq
15826# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15827#elif defined(MFC_OpenMP)
15828# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15829
15830# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15831#endif
15832 do i = eqn_idx%adv%beg, eqn_idx%adv%end
15833 flux_rsy_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
15834 end do
15835
15836 flux_src_rsy_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
15837 end do
15838 end do
15839 end do
15840
15841# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15842#if defined(MFC_OpenACC)
15843# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15844!$acc end parallel loop
15845# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15846#elif defined(MFC_OpenMP)
15847# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15848
15849# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15850!$omp end target teams loop
15851# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15852#endif
15853 end if
15854# 3394 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15855 if (norm_dir == 3) then
15856
15857# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15858
15859# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15860#if defined(MFC_OpenACC)
15861# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15862!$acc parallel loop collapse(3) gang vector default(present) private(alpha_rho_L, alpha_rho_R, vel, alpha_L, alpha_R, rho, pres, E, H_no_mag, gamma, pi_inf, qv, vel_rms, B, c, c_fast, pres_mag, U_L, U_R, U_starL, U_starR, U_doubleL, U_doubleR, F_L, F_R, F_starL, F_starR, F_hlld, s_L, s_R, s_M, s_starL, s_starR, pTot_L, pTot_R, p_star, rhoL_star, rhoR_star, E_starL, E_starR, sqrt_rhoL_star, sqrt_rhoR_star, denom_ds, sign_Bx, vL_star, vR_star, wL_star, wR_star, v_double, w_double, By_double, Bz_double, E_doubleL, E_doubleR, E_double) copyin(norm_dir)
15863# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15864#elif defined(MFC_OpenMP)
15865# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15866
15867# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15868
15869# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15870
15871# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15872!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(alpha_rho_L, alpha_rho_R, vel, alpha_L, alpha_R, rho, pres, E, H_no_mag, gamma, pi_inf, qv, vel_rms, B, c, c_fast, pres_mag, U_L, U_R, U_starL, U_starR, U_doubleL, U_doubleR, F_L, F_R, F_starL, F_starR, F_hlld, s_L, s_R, s_M, s_starL, s_starR, pTot_L, pTot_R, p_star, rhoL_star, rhoR_star, E_starL, E_starR, sqrt_rhoL_star, sqrt_rhoR_star, denom_ds, sign_Bx, vL_star, vR_star, wL_star, wR_star, v_double, w_double, By_double, Bz_double, E_doubleL, E_doubleR, E_double) map(to:norm_dir)
15873# 3395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15874#endif
15875# 3401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15876 do l = is3%beg, is3%end
15877 do k = is2%beg, is2%end
15878 do j = is1%beg, is1%end
15879 ! (1) Extract the left/right primitive states
15880 do i = 1, eqn_idx%cont%end
15881 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
15882 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
15883 end do
15884
15885 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
15886 do i = 1, num_vels
15887 vel%L(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%cont%end + dir_idx(i))
15888 vel%R(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%cont%end + dir_idx(i))
15889 end do
15890
15891 vel_rms%L = sum(vel%L**2._wp)
15892 vel_rms%R = sum(vel%R**2._wp)
15893
15894 do i = 1, num_fluids
15895 alpha_l(i) = ql_prim_rsz_vf(j, k, l, eqn_idx%E + i)
15896 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E + i)
15897 end do
15898
15899 pres%L = ql_prim_rsz_vf(j, k, l, eqn_idx%E)
15900 pres%R = qr_prim_rsz_vf(j + 1, k, l, eqn_idx%E)
15901
15902 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
15903 if (mhd) then
15904 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
15905 b%L = [bx0, ql_prim_rsz_vf(j, k, l, eqn_idx%B%beg), ql_prim_rsz_vf(j, k, l, &
15906 & eqn_idx%B%beg + 1)]
15907 b%R = [bx0, qr_prim_rsz_vf(j + 1, k, l, eqn_idx%B%beg), qr_prim_rsz_vf(j + 1, k, &
15908 & l, eqn_idx%B%beg + 1)]
15909 else ! 2D/3D: Bx, By, Bz as variables
15910 b%L = [ql_prim_rsz_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1), ql_prim_rsz_vf(j, &
15911 & k, l, eqn_idx%B%beg + dir_idx(2) - 1), ql_prim_rsz_vf(j, &
15912 & k, l, eqn_idx%B%beg + dir_idx(3) - 1)]
15913 b%R = [qr_prim_rsz_vf(j + 1, k, l, eqn_idx%B%beg + dir_idx(1) - 1), &
15914 & qr_prim_rsz_vf(j + 1, k, l, &
15915 & eqn_idx%B%beg + dir_idx(2) - 1), qr_prim_rsz_vf(j + 1, k, &
15916 & l, eqn_idx%B%beg + dir_idx(3) - 1)]
15917 end if
15918 end if
15919
15920 ! Sum properties of all fluid components
15921 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
15922 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
15923
15924# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15925#if defined(MFC_OpenACC)
15926# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15927!$acc loop seq
15928# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15929#elif defined(MFC_OpenMP)
15930# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15931
15932# 3448 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15933#endif
15934 do i = 1, num_fluids
15935 rho%L = rho%L + alpha_rho_l(i)
15936 gamma%L = gamma%L + alpha_l(i)*gammas(i)
15937 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
15938 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
15939
15940 rho%R = rho%R + alpha_rho_r(i)
15941 gamma%R = gamma%R + alpha_r(i)*gammas(i)
15942 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
15943 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
15944 end do
15945
15946 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
15947 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
15948 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
15949 e%R = gamma%R*pres%R + pi_inf%R + 0.5_wp*rho%R*vel_rms%R + qv%R + pres_mag%R ! includes magnetic energy
15950 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
15951 h_no_mag%R = (e%R + pres%R - pres_mag%R) &
15952 & /rho%R ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
15953
15954 ! (2) Compute fast wave speeds
15955 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, &
15956 & 0._wp, c%L, qv%L)
15957 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, &
15958 & 0._wp, c%R, qv%R)
15959 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
15960 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
15961
15962 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
15963 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
15964 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
15965
15966 ptot_l = pres%L + pres_mag%L
15967 ptot_r = pres%R + pres_mag%R
15968
15969 s_m = (((s_r - vel%R(1))*rho%R*vel%R(1) - (s_l - vel%L(1))*rho%L*vel%L(1) - ptot_r + ptot_l)/((s_r &
15970 & - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
15971
15972 ! (4) Compute star state variables
15973 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
15974 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
15975 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
15976 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
15977 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
15978
15979 ! (5) Compute left/right state vectors and fluxes
15980 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
15981 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
15982 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
15983 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
15984
15985 ! Compute the left/right fluxes
15986 f_l(1) = u_l(2)
15987 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
15988 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
15989 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
15990 f_l(7) = (e%L + ptot_l)*vel%L(1) - b%L(1)*(vel%L(1)*b%L(1) + vel%L(2)*b%L(2) + vel%L(3)*b%L(3))
15991
15992 f_r(1) = u_r(2)
15993 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
15994 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
15995 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
15996 f_r(7) = (e%R + ptot_r)*vel%R(1) - b%R(1)*(vel%R(1)*b%R(1) + vel%R(2)*b%R(2) + vel%R(3)*b%R(3))
15997 ! HLLD star-state fluxes via HLL jump relation
15998 f_starl = f_l + s_l*(u_starl - u_l)
15999 f_starr = f_r + s_r*(u_starr - u_r)
16000 ! Alfven wave speeds bounding the rotational discontinuities
16001 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
16002 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
16003 ! HLLD double-star (intermediate) states across rotational discontinuities
16004 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
16005 vl_star = vel%L(2); wl_star = vel%L(3)
16006 vr_star = vel%R(2); wr_star = vel%R(3)
16007
16008 ! (6) Compute the double-star states [Miyoshi Eqns. (59)-(62)]
16009 denom_ds = sqrt_rhol_star + sqrt_rhor_star
16010 sign_bx = sign(1._wp, b%L(1))
16011 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
16012 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
16013 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star &
16014 & - vl_star)*sign_bx)/denom_ds
16015 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star &
16016 & - wl_star)*sign_bx)/denom_ds
16017
16018 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double &
16019 & + w_double*bz_double))*sign_bx
16020 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double &
16021 & + w_double*bz_double))*sign_bx
16022 e_double = 0.5_wp*(e_doublel + e_doubler)
16023
16024 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, &
16025 & e_double]
16026 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, &
16027 & e_double]
16028
16029 ! Select HLLD flux region
16030 if (0.0_wp <= s_l) then
16031 f_hlld = f_l
16032 else if (0.0_wp <= s_starl) then
16033 f_hlld = f_l + s_l*(u_starl - u_l)
16034 else if (0.0_wp <= s_m) then
16035 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
16036 else if (0.0_wp <= s_starr) then
16037 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
16038 else if (0.0_wp <= s_r) then
16039 f_hlld = f_r + s_r*(u_starr - u_r)
16040 else
16041 f_hlld = f_r
16042 end if
16043
16044 ! (12) Write HLLD flux to output arrays
16045 flux_rsz_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
16046 ! Momentum
16047 flux_rsz_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(2)
16048 flux_rsz_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(3)
16049 flux_rsz_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(4)
16050 ! Magnetic field
16051 if (n == 0) then
16052 flux_rsz_vf(j, k, l, eqn_idx%B%beg) = f_hlld(5)
16053 flux_rsz_vf(j, k, l, eqn_idx%B%beg + 1) = f_hlld(6)
16054 else
16055 flux_rsz_vf(j, k, l, eqn_idx%B%beg + dir_idx(2) - 1) = f_hlld(5)
16056 flux_rsz_vf(j, k, l, eqn_idx%B%beg + dir_idx(3) - 1) = f_hlld(6)
16057 end if
16058 ! Energy
16059 flux_rsz_vf(j, k, l, eqn_idx%E) = f_hlld(7)
16060 ! Volume fractions
16061
16062# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16063#if defined(MFC_OpenACC)
16064# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16065!$acc loop seq
16066# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16067#elif defined(MFC_OpenMP)
16068# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16069
16070# 3576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16071#endif
16072 do i = eqn_idx%adv%beg, eqn_idx%adv%end
16073 flux_rsz_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
16074 end do
16075
16076 flux_src_rsz_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
16077 end do
16078 end do
16079 end do
16080
16081# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16082#if defined(MFC_OpenACC)
16083# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16084!$acc end parallel loop
16085# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16086#elif defined(MFC_OpenMP)
16087# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16088
16089# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16090!$omp end target teams loop
16091# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16092#endif
16093 end if
16094# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16095
16096 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
16097
16098 end subroutine s_hlld_riemann_solver
16099
16100 !> Initialize the Riemann solvers module
16101 impure subroutine s_initialize_riemann_solvers_module
16102
16103 ! Allocating the variables that will be utilized to formulate the left, right, and average states of the Riemann problem, as
16104 ! well the Riemann problem solution
16105 integer :: i, j
16106
16107#ifdef MFC_DEBUG
16108# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16109 block
16110# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16111 use iso_fortran_env, only: output_unit
16112# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16113
16114# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16115 print *, 'm_riemann_solvers.fpp:3600: ', '@:ALLOCATE(Gs_rs(1:num_fluids))'
16116# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16117
16118# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16119 call flush (output_unit)
16120# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16121 end block
16122# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16123#endif
16124# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16125 allocate (gs_rs(1:num_fluids))
16126# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16127
16128# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16129
16130# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16131#if defined(MFC_OpenACC)
16132# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16133!$acc enter data create(Gs_rs)
16134# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16135#elif defined(MFC_OpenMP)
16136# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16137!$omp target enter data map(always,alloc:Gs_rs)
16138# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16139#endif
16140
16141 do i = 1, num_fluids
16142 gs_rs(i) = fluid_pp(i)%G
16143 end do
16144
16145# 3605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16146#if defined(MFC_OpenACC)
16147# 3605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16148!$acc update device(Gs_rs)
16149# 3605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16150#elif defined(MFC_OpenMP)
16151# 3605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16152!$omp target update to(Gs_rs)
16153# 3605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16154#endif
16155
16156 if (viscous) then
16157#ifdef MFC_DEBUG
16158# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16159 block
16160# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16161 use iso_fortran_env, only: output_unit
16162# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16163
16164# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16165 print *, 'm_riemann_solvers.fpp:3608: ', '@:ALLOCATE(Res_gs(1:2, 1:Re_size_max))'
16166# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16167
16168# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16169 call flush (output_unit)
16170# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16171 end block
16172# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16173#endif
16174# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16175 allocate (res_gs(1:2, 1:re_size_max))
16176# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16177
16178# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16179
16180# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16181#if defined(MFC_OpenACC)
16182# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16183!$acc enter data create(Res_gs)
16184# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16185#elif defined(MFC_OpenMP)
16186# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16187!$omp target enter data map(always,alloc:Res_gs)
16188# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16189#endif
16190 end if
16191
16192 if (viscous) then
16193 do i = 1, 2
16194 do j = 1, re_size(i)
16195 res_gs(i, j) = fluid_pp(re_idx(i, j))%Re(i)
16196 end do
16197 end do
16198
16199# 3617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16200#if defined(MFC_OpenACC)
16201# 3617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16202!$acc update device(Res_gs, Re_idx, Re_size)
16203# 3617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16204#elif defined(MFC_OpenMP)
16205# 3617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16206!$omp target update to(Res_gs, Re_idx, Re_size)
16207# 3617 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16208#endif
16209 end if
16210
16211
16212# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16213#if defined(MFC_OpenACC)
16214# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16215!$acc enter data copyin(is1, is2, is3, isx, isy, isz)
16216# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16217#elif defined(MFC_OpenMP)
16218# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16219!$omp target enter data map(to:is1, is2, is3, isx, isy, isz)
16220# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16221#endif
16222
16223 is1%beg = -1; is2%beg = 0; is3%beg = 0
16224 is1%end = m; is2%end = n; is3%end = p
16225
16226#ifdef MFC_DEBUG
16227# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16228 block
16229# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16230 use iso_fortran_env, only: output_unit
16231# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16232
16233# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16234 print *, 'm_riemann_solvers.fpp:3625: ', '@:ALLOCATE(flux_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
16235# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16236
16237# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16238 call flush (output_unit)
16239# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16240 end block
16241# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16242#endif
16243# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16244 allocate (flux_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
16245# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16246
16247# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16248
16249# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16250#if defined(MFC_OpenACC)
16251# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16252!$acc enter data create(flux_rsx_vf)
16253# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16254#elif defined(MFC_OpenMP)
16255# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16256!$omp target enter data map(always,alloc:flux_rsx_vf)
16257# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16258#endif
16259#ifdef MFC_DEBUG
16260# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16261 block
16262# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16263 use iso_fortran_env, only: output_unit
16264# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16265
16266# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16267 print *, 'm_riemann_solvers.fpp:3626: ', '@:ALLOCATE(flux_gsrc_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
16268# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16269
16270# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16271 call flush (output_unit)
16272# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16273 end block
16274# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16275#endif
16276# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16277 allocate (flux_gsrc_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
16278# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16279
16280# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16281
16282# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16283#if defined(MFC_OpenACC)
16284# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16285!$acc enter data create(flux_gsrc_rsx_vf)
16286# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16287#elif defined(MFC_OpenMP)
16288# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16289!$omp target enter data map(always,alloc:flux_gsrc_rsx_vf)
16290# 3626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16291#endif
16292#ifdef MFC_DEBUG
16293# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16294 block
16295# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16296 use iso_fortran_env, only: output_unit
16297# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16298
16299# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16300 print *, 'm_riemann_solvers.fpp:3627: ', '@:ALLOCATE(flux_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:sys_size))'
16301# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16302
16303# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16304 call flush (output_unit)
16305# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16306 end block
16307# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16308#endif
16309# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16310 allocate (flux_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:sys_size))
16311# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16312
16313# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16314
16315# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16316#if defined(MFC_OpenACC)
16317# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16318!$acc enter data create(flux_src_rsx_vf)
16319# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16320#elif defined(MFC_OpenMP)
16321# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16322!$omp target enter data map(always,alloc:flux_src_rsx_vf)
16323# 3627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16324#endif
16325#ifdef MFC_DEBUG
16326# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16327 block
16328# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16329 use iso_fortran_env, only: output_unit
16330# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16331
16332# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16333 print *, 'm_riemann_solvers.fpp:3628: ', '@:ALLOCATE(vel_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))'
16334# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16335
16336# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16337 call flush (output_unit)
16338# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16339 end block
16340# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16341#endif
16342# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16343 allocate (vel_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))
16344# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16345
16346# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16347
16348# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16349#if defined(MFC_OpenACC)
16350# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16351!$acc enter data create(vel_src_rsx_vf)
16352# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16353#elif defined(MFC_OpenMP)
16354# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16355!$omp target enter data map(always,alloc:vel_src_rsx_vf)
16356# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16357#endif
16358 if (qbmm) then
16359#ifdef MFC_DEBUG
16360# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16361 block
16362# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16363 use iso_fortran_env, only: output_unit
16364# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16365
16366# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16367 print *, 'm_riemann_solvers.fpp:3630: ', '@:ALLOCATE(mom_sp_rsx_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))'
16368# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16369
16370# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16371 call flush (output_unit)
16372# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16373 end block
16374# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16375#endif
16376# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16377 allocate (mom_sp_rsx_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))
16378# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16379
16380# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16381
16382# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16383#if defined(MFC_OpenACC)
16384# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16385!$acc enter data create(mom_sp_rsx_vf)
16386# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16387#elif defined(MFC_OpenMP)
16388# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16389!$omp target enter data map(always,alloc:mom_sp_rsx_vf)
16390# 3630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16391#endif
16392 end if
16393
16394 if (viscous) then
16395#ifdef MFC_DEBUG
16396# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16397 block
16398# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16399 use iso_fortran_env, only: output_unit
16400# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16401
16402# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16403 print *, 'm_riemann_solvers.fpp:3634: ', '@:ALLOCATE(Re_avg_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))'
16404# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16405
16406# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16407 call flush (output_unit)
16408# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16409 end block
16410# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16411#endif
16412# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16413 allocate (re_avg_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))
16414# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16415
16416# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16417
16418# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16419#if defined(MFC_OpenACC)
16420# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16421!$acc enter data create(Re_avg_rsx_vf)
16422# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16423#elif defined(MFC_OpenMP)
16424# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16425!$omp target enter data map(always,alloc:Re_avg_rsx_vf)
16426# 3634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16427#endif
16428 end if
16429
16430 if (n == 0) return
16431
16432 is1%beg = -1; is2%beg = 0; is3%beg = 0
16433 is1%end = n; is2%end = m; is3%end = p
16434
16435#ifdef MFC_DEBUG
16436# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16437 block
16438# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16439 use iso_fortran_env, only: output_unit
16440# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16441
16442# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16443 print *, 'm_riemann_solvers.fpp:3642: ', '@:ALLOCATE(flux_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
16444# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16445
16446# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16447 call flush (output_unit)
16448# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16449 end block
16450# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16451#endif
16452# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16453 allocate (flux_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
16454# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16455
16456# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16457
16458# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16459#if defined(MFC_OpenACC)
16460# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16461!$acc enter data create(flux_rsy_vf)
16462# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16463#elif defined(MFC_OpenMP)
16464# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16465!$omp target enter data map(always,alloc:flux_rsy_vf)
16466# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16467#endif
16468#ifdef MFC_DEBUG
16469# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16470 block
16471# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16472 use iso_fortran_env, only: output_unit
16473# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16474
16475# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16476 print *, 'm_riemann_solvers.fpp:3643: ', '@:ALLOCATE(flux_gsrc_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
16477# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16478
16479# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16480 call flush (output_unit)
16481# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16482 end block
16483# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16484#endif
16485# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16486 allocate (flux_gsrc_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
16487# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16488
16489# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16490
16491# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16492#if defined(MFC_OpenACC)
16493# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16494!$acc enter data create(flux_gsrc_rsy_vf)
16495# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16496#elif defined(MFC_OpenMP)
16497# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16498!$omp target enter data map(always,alloc:flux_gsrc_rsy_vf)
16499# 3643 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16500#endif
16501#ifdef MFC_DEBUG
16502# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16503 block
16504# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16505 use iso_fortran_env, only: output_unit
16506# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16507
16508# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16509 print *, 'm_riemann_solvers.fpp:3644: ', '@:ALLOCATE(flux_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:sys_size))'
16510# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16511
16512# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16513 call flush (output_unit)
16514# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16515 end block
16516# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16517#endif
16518# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16519 allocate (flux_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:sys_size))
16520# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16521
16522# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16523
16524# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16525#if defined(MFC_OpenACC)
16526# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16527!$acc enter data create(flux_src_rsy_vf)
16528# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16529#elif defined(MFC_OpenMP)
16530# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16531!$omp target enter data map(always,alloc:flux_src_rsy_vf)
16532# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16533#endif
16534#ifdef MFC_DEBUG
16535# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16536 block
16537# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16538 use iso_fortran_env, only: output_unit
16539# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16540
16541# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16542 print *, 'm_riemann_solvers.fpp:3645: ', '@:ALLOCATE(vel_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))'
16543# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16544
16545# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16546 call flush (output_unit)
16547# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16548 end block
16549# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16550#endif
16551# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16552 allocate (vel_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))
16553# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16554
16555# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16556
16557# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16558#if defined(MFC_OpenACC)
16559# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16560!$acc enter data create(vel_src_rsy_vf)
16561# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16562#elif defined(MFC_OpenMP)
16563# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16564!$omp target enter data map(always,alloc:vel_src_rsy_vf)
16565# 3645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16566#endif
16567
16568 if (qbmm) then
16569#ifdef MFC_DEBUG
16570# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16571 block
16572# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16573 use iso_fortran_env, only: output_unit
16574# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16575
16576# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16577 print *, 'm_riemann_solvers.fpp:3648: ', '@:ALLOCATE(mom_sp_rsy_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))'
16578# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16579
16580# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16581 call flush (output_unit)
16582# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16583 end block
16584# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16585#endif
16586# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16587 allocate (mom_sp_rsy_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))
16588# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16589
16590# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16591
16592# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16593#if defined(MFC_OpenACC)
16594# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16595!$acc enter data create(mom_sp_rsy_vf)
16596# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16597#elif defined(MFC_OpenMP)
16598# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16599!$omp target enter data map(always,alloc:mom_sp_rsy_vf)
16600# 3648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16601#endif
16602 end if
16603
16604 if (viscous) then
16605#ifdef MFC_DEBUG
16606# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16607 block
16608# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16609 use iso_fortran_env, only: output_unit
16610# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16611
16612# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16613 print *, 'm_riemann_solvers.fpp:3652: ', '@:ALLOCATE(Re_avg_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))'
16614# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16615
16616# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16617 call flush (output_unit)
16618# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16619 end block
16620# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16621#endif
16622# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16623 allocate (re_avg_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))
16624# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16625
16626# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16627
16628# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16629#if defined(MFC_OpenACC)
16630# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16631!$acc enter data create(Re_avg_rsy_vf)
16632# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16633#elif defined(MFC_OpenMP)
16634# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16635!$omp target enter data map(always,alloc:Re_avg_rsy_vf)
16636# 3652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16637#endif
16638 end if
16639
16640 if (p == 0) return
16641
16642 is1%beg = -1; is2%beg = 0; is3%beg = 0
16643 is1%end = p; is2%end = n; is3%end = m
16644
16645#ifdef MFC_DEBUG
16646# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16647 block
16648# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16649 use iso_fortran_env, only: output_unit
16650# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16651
16652# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16653 print *, 'm_riemann_solvers.fpp:3660: ', '@:ALLOCATE(flux_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
16654# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16655
16656# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16657 call flush (output_unit)
16658# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16659 end block
16660# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16661#endif
16662# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16663 allocate (flux_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
16664# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16665
16666# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16667
16668# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16669#if defined(MFC_OpenACC)
16670# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16671!$acc enter data create(flux_rsz_vf)
16672# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16673#elif defined(MFC_OpenMP)
16674# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16675!$omp target enter data map(always,alloc:flux_rsz_vf)
16676# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16677#endif
16678#ifdef MFC_DEBUG
16679# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16680 block
16681# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16682 use iso_fortran_env, only: output_unit
16683# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16684
16685# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16686 print *, 'm_riemann_solvers.fpp:3661: ', '@:ALLOCATE(flux_gsrc_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
16687# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16688
16689# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16690 call flush (output_unit)
16691# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16692 end block
16693# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16694#endif
16695# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16696 allocate (flux_gsrc_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
16697# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16698
16699# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16700
16701# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16702#if defined(MFC_OpenACC)
16703# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16704!$acc enter data create(flux_gsrc_rsz_vf)
16705# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16706#elif defined(MFC_OpenMP)
16707# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16708!$omp target enter data map(always,alloc:flux_gsrc_rsz_vf)
16709# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16710#endif
16711#ifdef MFC_DEBUG
16712# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16713 block
16714# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16715 use iso_fortran_env, only: output_unit
16716# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16717
16718# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16719 print *, 'm_riemann_solvers.fpp:3662: ', '@:ALLOCATE(flux_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:sys_size))'
16720# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16721
16722# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16723 call flush (output_unit)
16724# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16725 end block
16726# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16727#endif
16728# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16729 allocate (flux_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, eqn_idx%adv%beg:sys_size))
16730# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16731
16732# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16733
16734# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16735#if defined(MFC_OpenACC)
16736# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16737!$acc enter data create(flux_src_rsz_vf)
16738# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16739#elif defined(MFC_OpenMP)
16740# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16741!$omp target enter data map(always,alloc:flux_src_rsz_vf)
16742# 3662 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16743#endif
16744#ifdef MFC_DEBUG
16745# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16746 block
16747# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16748 use iso_fortran_env, only: output_unit
16749# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16750
16751# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16752 print *, 'm_riemann_solvers.fpp:3663: ', '@:ALLOCATE(vel_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))'
16753# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16754
16755# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16756 call flush (output_unit)
16757# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16758 end block
16759# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16760#endif
16761# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16762 allocate (vel_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))
16763# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16764
16765# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16766
16767# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16768#if defined(MFC_OpenACC)
16769# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16770!$acc enter data create(vel_src_rsz_vf)
16771# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16772#elif defined(MFC_OpenMP)
16773# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16774!$omp target enter data map(always,alloc:vel_src_rsz_vf)
16775# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16776#endif
16777
16778 if (qbmm) then
16779#ifdef MFC_DEBUG
16780# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16781 block
16782# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16783 use iso_fortran_env, only: output_unit
16784# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16785
16786# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16787 print *, 'm_riemann_solvers.fpp:3666: ', '@:ALLOCATE(mom_sp_rsz_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))'
16788# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16789
16790# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16791 call flush (output_unit)
16792# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16793 end block
16794# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16795#endif
16796# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16797 allocate (mom_sp_rsz_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))
16798# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16799
16800# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16801
16802# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16803#if defined(MFC_OpenACC)
16804# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16805!$acc enter data create(mom_sp_rsz_vf)
16806# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16807#elif defined(MFC_OpenMP)
16808# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16809!$omp target enter data map(always,alloc:mom_sp_rsz_vf)
16810# 3666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16811#endif
16812 end if
16813
16814 if (viscous) then
16815#ifdef MFC_DEBUG
16816# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16817 block
16818# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16819 use iso_fortran_env, only: output_unit
16820# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16821
16822# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16823 print *, 'm_riemann_solvers.fpp:3670: ', '@:ALLOCATE(Re_avg_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))'
16824# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16825
16826# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16827 call flush (output_unit)
16828# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16829 end block
16830# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16831#endif
16832# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16833 allocate (re_avg_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))
16834# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16835
16836# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16837
16838# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16839#if defined(MFC_OpenACC)
16840# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16841!$acc enter data create(Re_avg_rsz_vf)
16842# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16843#elif defined(MFC_OpenMP)
16844# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16845!$omp target enter data map(always,alloc:Re_avg_rsz_vf)
16846# 3670 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16847#endif
16848 end if
16849
16850 end subroutine s_initialize_riemann_solvers_module
16851
16852 !> Populate the left and right Riemann state variable buffers based on boundary conditions
16853 subroutine s_populate_riemann_states_variables_buffers(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, &
16854
16855 & dqL_prim_dy_vf, dqL_prim_dz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, &
16856 & dqR_prim_dz_vf, norm_dir, ix, iy, iz)
16857
16858 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, &
16859 & qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf
16860
16861 type(scalar_field), allocatable, dimension(:), intent(inout) :: dqL_prim_dx_vf, dqR_prim_dx_vf, dqL_prim_dy_vf, &
16862 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
16863
16864 integer, intent(in) :: norm_dir
16865 type(int_bounds_info), intent(in) :: ix, iy, iz
16866 integer :: i, j, k, l !< Generic loop iterator
16867
16868 if (norm_dir == 1) then
16869 is1 = ix; is2 = iy; is3 = iz
16870 dir_idx = (/1, 2, 3/); dir_flg = (/1._wp, 0._wp, 0._wp/)
16871 else if (norm_dir == 2) then
16872 is1 = iy; is2 = ix; is3 = iz
16873 dir_idx = (/2, 1, 3/); dir_flg = (/0._wp, 1._wp, 0._wp/)
16874 else
16875 is1 = iz; is2 = iy; is3 = ix
16876 dir_idx = (/3, 1, 2/); dir_flg = (/0._wp, 0._wp, 1._wp/)
16877 end if
16878
16879
16880# 3702 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16881#if defined(MFC_OpenACC)
16882# 3702 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16883!$acc update device(is1, is2, is3)
16884# 3702 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16885#elif defined(MFC_OpenMP)
16886# 3702 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16887!$omp target update to(is1, is2, is3)
16888# 3702 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16889#endif
16890
16891 if (elasticity) then
16892 if (norm_dir == 1) then
16893 dir_idx_tau = (/1, 2, 4/)
16894 else if (norm_dir == 2) then
16895 dir_idx_tau = (/3, 2, 5/)
16896 else
16897 dir_idx_tau = (/6, 4, 5/)
16898 end if
16899 end if
16900
16901 isx = ix; isy = iy; isz = iz
16902 ! for stuff in the same module
16903
16904# 3716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16905#if defined(MFC_OpenACC)
16906# 3716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16907!$acc update device(isx, isy, isz)
16908# 3716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16909#elif defined(MFC_OpenMP)
16910# 3716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16911!$omp target update to(isx, isy, isz)
16912# 3716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16913#endif
16914 ! for stuff in different modules
16915
16916# 3718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16917#if defined(MFC_OpenACC)
16918# 3718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16919!$acc update device(dir_idx, dir_flg, dir_idx_tau)
16920# 3718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16921#elif defined(MFC_OpenMP)
16922# 3718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16923!$omp target update to(dir_idx, dir_flg, dir_idx_tau)
16924# 3718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16925#endif
16926
16927 ! Population of Buffers in x-direction
16928 if (norm_dir == 1) then
16929 if (bc_x%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
16930
16931# 3723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16932
16933# 3723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16934#if defined(MFC_OpenACC)
16935# 3723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16936!$acc parallel loop collapse(3) gang vector default(present)
16937# 3723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16938#elif defined(MFC_OpenMP)
16939# 3723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16940
16941# 3723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16942
16943# 3723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16944
16945# 3723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16946!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16947# 3723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16948#endif
16949 do i = 1, sys_size
16950 do l = is3%beg, is3%end
16951 do k = is2%beg, is2%end
16952 ql_prim_rsx_vf(-1, k, l, i) = qr_prim_rsx_vf(0, k, l, i)
16953 end do
16954 end do
16955 end do
16956
16957# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16958#if defined(MFC_OpenACC)
16959# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16960!$acc end parallel loop
16961# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16962#elif defined(MFC_OpenMP)
16963# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16964
16965# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16966!$omp end target teams loop
16967# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16968#endif
16969
16970 if (viscous .or. dummy) then
16971
16972# 3734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16973
16974# 3734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16975#if defined(MFC_OpenACC)
16976# 3734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16977!$acc parallel loop collapse(3) gang vector default(present)
16978# 3734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16979#elif defined(MFC_OpenMP)
16980# 3734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16981
16982# 3734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16983
16984# 3734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16985
16986# 3734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16987!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16988# 3734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16989#endif
16990 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16991 do l = isz%beg, isz%end
16992 do k = isy%beg, isy%end
16993 dql_prim_dx_vf(i)%sf(-1, k, l) = dqr_prim_dx_vf(i)%sf(0, k, l)
16994 end do
16995 end do
16996 end do
16997
16998# 3742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16999#if defined(MFC_OpenACC)
17000# 3742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17001!$acc end parallel loop
17002# 3742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17003#elif defined(MFC_OpenMP)
17004# 3742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17005
17006# 3742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17007!$omp end target teams loop
17008# 3742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17009#endif
17010
17011 if (n > 0) then
17012
17013# 3745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17014
17015# 3745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17016#if defined(MFC_OpenACC)
17017# 3745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17018!$acc parallel loop collapse(3) gang vector default(present)
17019# 3745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17020#elif defined(MFC_OpenMP)
17021# 3745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17022
17023# 3745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17024
17025# 3745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17026
17027# 3745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17028!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17029# 3745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17030#endif
17031 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17032 do l = isz%beg, isz%end
17033 do k = isy%beg, isy%end
17034 dql_prim_dy_vf(i)%sf(-1, k, l) = dqr_prim_dy_vf(i)%sf(0, k, l)
17035 end do
17036 end do
17037 end do
17038
17039# 3753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17040#if defined(MFC_OpenACC)
17041# 3753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17042!$acc end parallel loop
17043# 3753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17044#elif defined(MFC_OpenMP)
17045# 3753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17046
17047# 3753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17048!$omp end target teams loop
17049# 3753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17050#endif
17051
17052 if (p > 0) then
17053
17054# 3756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17055
17056# 3756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17057#if defined(MFC_OpenACC)
17058# 3756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17059!$acc parallel loop collapse(3) gang vector default(present)
17060# 3756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17061#elif defined(MFC_OpenMP)
17062# 3756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17063
17064# 3756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17065
17066# 3756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17067
17068# 3756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17069!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17070# 3756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17071#endif
17072 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17073 do l = isz%beg, isz%end
17074 do k = isy%beg, isy%end
17075 dql_prim_dz_vf(i)%sf(-1, k, l) = dqr_prim_dz_vf(i)%sf(0, k, l)
17076 end do
17077 end do
17078 end do
17079
17080# 3764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17081#if defined(MFC_OpenACC)
17082# 3764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17083!$acc end parallel loop
17084# 3764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17085#elif defined(MFC_OpenMP)
17086# 3764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17087
17088# 3764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17089!$omp end target teams loop
17090# 3764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17091#endif
17092 end if
17093 end if
17094 end if
17095 end if
17096
17097 if (bc_x%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
17098
17099
17100# 3772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17101
17102# 3772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17103#if defined(MFC_OpenACC)
17104# 3772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17105!$acc parallel loop collapse(3) gang vector default(present)
17106# 3772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17107#elif defined(MFC_OpenMP)
17108# 3772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17109
17110# 3772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17111
17112# 3772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17113
17114# 3772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17115!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17116# 3772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17117#endif
17118 do i = 1, sys_size
17119 do l = is3%beg, is3%end
17120 do k = is2%beg, is2%end
17121 qr_prim_rsx_vf(m + 1, k, l, i) = ql_prim_rsx_vf(m, k, l, i)
17122 end do
17123 end do
17124 end do
17125
17126# 3780 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17127#if defined(MFC_OpenACC)
17128# 3780 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17129!$acc end parallel loop
17130# 3780 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17131#elif defined(MFC_OpenMP)
17132# 3780 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17133
17134# 3780 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17135!$omp end target teams loop
17136# 3780 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17137#endif
17138
17139 if (viscous .or. dummy) then
17140
17141# 3783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17142
17143# 3783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17144#if defined(MFC_OpenACC)
17145# 3783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17146!$acc parallel loop collapse(3) gang vector default(present)
17147# 3783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17148#elif defined(MFC_OpenMP)
17149# 3783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17150
17151# 3783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17152
17153# 3783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17154
17155# 3783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17156!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17157# 3783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17158#endif
17159 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17160 do l = isz%beg, isz%end
17161 do k = isy%beg, isy%end
17162 dqr_prim_dx_vf(i)%sf(m + 1, k, l) = dql_prim_dx_vf(i)%sf(m, k, l)
17163 end do
17164 end do
17165 end do
17166
17167# 3791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17168#if defined(MFC_OpenACC)
17169# 3791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17170!$acc end parallel loop
17171# 3791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17172#elif defined(MFC_OpenMP)
17173# 3791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17174
17175# 3791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17176!$omp end target teams loop
17177# 3791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17178#endif
17179
17180 if (n > 0) then
17181
17182# 3794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17183
17184# 3794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17185#if defined(MFC_OpenACC)
17186# 3794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17187!$acc parallel loop collapse(3) gang vector default(present)
17188# 3794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17189#elif defined(MFC_OpenMP)
17190# 3794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17191
17192# 3794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17193
17194# 3794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17195
17196# 3794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17197!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17198# 3794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17199#endif
17200 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17201 do l = isz%beg, isz%end
17202 do k = isy%beg, isy%end
17203 dqr_prim_dy_vf(i)%sf(m + 1, k, l) = dql_prim_dy_vf(i)%sf(m, k, l)
17204 end do
17205 end do
17206 end do
17207
17208# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17209#if defined(MFC_OpenACC)
17210# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17211!$acc end parallel loop
17212# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17213#elif defined(MFC_OpenMP)
17214# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17215
17216# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17217!$omp end target teams loop
17218# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17219#endif
17220
17221 if (p > 0) then
17222
17223# 3805 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17224
17225# 3805 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17226#if defined(MFC_OpenACC)
17227# 3805 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17228!$acc parallel loop collapse(3) gang vector default(present)
17229# 3805 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17230#elif defined(MFC_OpenMP)
17231# 3805 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17232
17233# 3805 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17234
17235# 3805 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17236
17237# 3805 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17238!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17239# 3805 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17240#endif
17241 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17242 do l = isz%beg, isz%end
17243 do k = isy%beg, isy%end
17244 dqr_prim_dz_vf(i)%sf(m + 1, k, l) = dql_prim_dz_vf(i)%sf(m, k, l)
17245 end do
17246 end do
17247 end do
17248
17249# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17250#if defined(MFC_OpenACC)
17251# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17252!$acc end parallel loop
17253# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17254#elif defined(MFC_OpenMP)
17255# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17256
17257# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17258!$omp end target teams loop
17259# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17260#endif
17261 end if
17262 end if
17263 end if
17264 end if
17265 ! END: Population of Buffers in x-direction
17266
17267 ! Population of Buffers in y-direction
17268 else if (norm_dir == 2) then
17269 if (bc_y%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
17270
17271# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17272
17273# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17274#if defined(MFC_OpenACC)
17275# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17276!$acc parallel loop collapse(3) gang vector default(present)
17277# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17278#elif defined(MFC_OpenMP)
17279# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17280
17281# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17282
17283# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17284
17285# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17286!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17287# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17288#endif
17289 do i = 1, sys_size
17290 do l = is3%beg, is3%end
17291 do k = is2%beg, is2%end
17292 ql_prim_rsy_vf(-1, k, l, i) = qr_prim_rsy_vf(0, k, l, i)
17293 end do
17294 end do
17295 end do
17296
17297# 3831 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17298#if defined(MFC_OpenACC)
17299# 3831 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17300!$acc end parallel loop
17301# 3831 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17302#elif defined(MFC_OpenMP)
17303# 3831 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17304
17305# 3831 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17306!$omp end target teams loop
17307# 3831 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17308#endif
17309
17310 if (viscous .or. dummy) then
17311
17312# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17313
17314# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17315#if defined(MFC_OpenACC)
17316# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17317!$acc parallel loop collapse(3) gang vector default(present)
17318# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17319#elif defined(MFC_OpenMP)
17320# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17321
17322# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17323
17324# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17325
17326# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17327!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17328# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17329#endif
17330 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17331 do l = isz%beg, isz%end
17332 do j = isx%beg, isx%end
17333 dql_prim_dx_vf(i)%sf(j, -1, l) = dqr_prim_dx_vf(i)%sf(j, 0, l)
17334 end do
17335 end do
17336 end do
17337
17338# 3842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17339#if defined(MFC_OpenACC)
17340# 3842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17341!$acc end parallel loop
17342# 3842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17343#elif defined(MFC_OpenMP)
17344# 3842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17345
17346# 3842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17347!$omp end target teams loop
17348# 3842 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17349#endif
17350
17351
17352# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17353
17354# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17355#if defined(MFC_OpenACC)
17356# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17357!$acc parallel loop collapse(3) gang vector default(present)
17358# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17359#elif defined(MFC_OpenMP)
17360# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17361
17362# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17363
17364# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17365
17366# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17367!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17368# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17369#endif
17370 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17371 do l = isz%beg, isz%end
17372 do j = isx%beg, isx%end
17373 dql_prim_dy_vf(i)%sf(j, -1, l) = dqr_prim_dy_vf(i)%sf(j, 0, l)
17374 end do
17375 end do
17376 end do
17377
17378# 3852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17379#if defined(MFC_OpenACC)
17380# 3852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17381!$acc end parallel loop
17382# 3852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17383#elif defined(MFC_OpenMP)
17384# 3852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17385
17386# 3852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17387!$omp end target teams loop
17388# 3852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17389#endif
17390
17391 if (p > 0) then
17392
17393# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17394
17395# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17396#if defined(MFC_OpenACC)
17397# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17398!$acc parallel loop collapse(3) gang vector default(present)
17399# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17400#elif defined(MFC_OpenMP)
17401# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17402
17403# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17404
17405# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17406
17407# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17408!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17409# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17410#endif
17411 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17412 do l = isz%beg, isz%end
17413 do j = isx%beg, isx%end
17414 dql_prim_dz_vf(i)%sf(j, -1, l) = dqr_prim_dz_vf(i)%sf(j, 0, l)
17415 end do
17416 end do
17417 end do
17418
17419# 3863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17420#if defined(MFC_OpenACC)
17421# 3863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17422!$acc end parallel loop
17423# 3863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17424#elif defined(MFC_OpenMP)
17425# 3863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17426
17427# 3863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17428!$omp end target teams loop
17429# 3863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17430#endif
17431 end if
17432 end if
17433 end if
17434
17435 if (bc_y%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
17436
17437
17438# 3870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17439
17440# 3870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17441#if defined(MFC_OpenACC)
17442# 3870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17443!$acc parallel loop collapse(3) gang vector default(present)
17444# 3870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17445#elif defined(MFC_OpenMP)
17446# 3870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17447
17448# 3870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17449
17450# 3870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17451
17452# 3870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17453!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17454# 3870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17455#endif
17456 do i = 1, sys_size
17457 do l = is3%beg, is3%end
17458 do k = is2%beg, is2%end
17459 qr_prim_rsy_vf(n + 1, k, l, i) = ql_prim_rsy_vf(n, k, l, i)
17460 end do
17461 end do
17462 end do
17463
17464# 3878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17465#if defined(MFC_OpenACC)
17466# 3878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17467!$acc end parallel loop
17468# 3878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17469#elif defined(MFC_OpenMP)
17470# 3878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17471
17472# 3878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17473!$omp end target teams loop
17474# 3878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17475#endif
17476
17477 if (viscous .or. dummy) then
17478
17479# 3881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17480
17481# 3881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17482#if defined(MFC_OpenACC)
17483# 3881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17484!$acc parallel loop collapse(3) gang vector default(present)
17485# 3881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17486#elif defined(MFC_OpenMP)
17487# 3881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17488
17489# 3881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17490
17491# 3881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17492
17493# 3881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17494!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17495# 3881 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17496#endif
17497 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17498 do l = isz%beg, isz%end
17499 do j = isx%beg, isx%end
17500 dqr_prim_dx_vf(i)%sf(j, n + 1, l) = dql_prim_dx_vf(i)%sf(j, n, l)
17501 end do
17502 end do
17503 end do
17504
17505# 3889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17506#if defined(MFC_OpenACC)
17507# 3889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17508!$acc end parallel loop
17509# 3889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17510#elif defined(MFC_OpenMP)
17511# 3889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17512
17513# 3889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17514!$omp end target teams loop
17515# 3889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17516#endif
17517
17518
17519# 3891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17520
17521# 3891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17522#if defined(MFC_OpenACC)
17523# 3891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17524!$acc parallel loop collapse(3) gang vector default(present)
17525# 3891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17526#elif defined(MFC_OpenMP)
17527# 3891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17528
17529# 3891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17530
17531# 3891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17532
17533# 3891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17534!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17535# 3891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17536#endif
17537 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17538 do l = isz%beg, isz%end
17539 do j = isx%beg, isx%end
17540 dqr_prim_dy_vf(i)%sf(j, n + 1, l) = dql_prim_dy_vf(i)%sf(j, n, l)
17541 end do
17542 end do
17543 end do
17544
17545# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17546#if defined(MFC_OpenACC)
17547# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17548!$acc end parallel loop
17549# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17550#elif defined(MFC_OpenMP)
17551# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17552
17553# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17554!$omp end target teams loop
17555# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17556#endif
17557
17558 if (p > 0) then
17559
17560# 3902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17561
17562# 3902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17563#if defined(MFC_OpenACC)
17564# 3902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17565!$acc parallel loop collapse(3) gang vector default(present)
17566# 3902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17567#elif defined(MFC_OpenMP)
17568# 3902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17569
17570# 3902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17571
17572# 3902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17573
17574# 3902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17575!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17576# 3902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17577#endif
17578 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17579 do l = isz%beg, isz%end
17580 do j = isx%beg, isx%end
17581 dqr_prim_dz_vf(i)%sf(j, n + 1, l) = dql_prim_dz_vf(i)%sf(j, n, l)
17582 end do
17583 end do
17584 end do
17585
17586# 3910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17587#if defined(MFC_OpenACC)
17588# 3910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17589!$acc end parallel loop
17590# 3910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17591#elif defined(MFC_OpenMP)
17592# 3910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17593
17594# 3910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17595!$omp end target teams loop
17596# 3910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17597#endif
17598 end if
17599 end if
17600 end if
17601 ! END: Population of Buffers in y-direction
17602
17603 ! Population of Buffers in z-direction
17604 else
17605 if (bc_z%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
17606
17607# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17608
17609# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17610#if defined(MFC_OpenACC)
17611# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17612!$acc parallel loop collapse(3) gang vector default(present)
17613# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17614#elif defined(MFC_OpenMP)
17615# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17616
17617# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17618
17619# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17620
17621# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17622!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17623# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17624#endif
17625 do i = 1, sys_size
17626 do l = is3%beg, is3%end
17627 do k = is2%beg, is2%end
17628 ql_prim_rsz_vf(-1, k, l, i) = qr_prim_rsz_vf(0, k, l, i)
17629 end do
17630 end do
17631 end do
17632
17633# 3927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17634#if defined(MFC_OpenACC)
17635# 3927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17636!$acc end parallel loop
17637# 3927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17638#elif defined(MFC_OpenMP)
17639# 3927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17640
17641# 3927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17642!$omp end target teams loop
17643# 3927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17644#endif
17645
17646 if (viscous .or. dummy) then
17647
17648# 3930 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17649
17650# 3930 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17651#if defined(MFC_OpenACC)
17652# 3930 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17653!$acc parallel loop collapse(3) gang vector default(present)
17654# 3930 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17655#elif defined(MFC_OpenMP)
17656# 3930 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17657
17658# 3930 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17659
17660# 3930 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17661
17662# 3930 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17663!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17664# 3930 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17665#endif
17666 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17667 do k = isy%beg, isy%end
17668 do j = isx%beg, isx%end
17669 dql_prim_dx_vf(i)%sf(j, k, -1) = dqr_prim_dx_vf(i)%sf(j, k, 0)
17670 end do
17671 end do
17672 end do
17673
17674# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17675#if defined(MFC_OpenACC)
17676# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17677!$acc end parallel loop
17678# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17679#elif defined(MFC_OpenMP)
17680# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17681
17682# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17683!$omp end target teams loop
17684# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17685#endif
17686
17687# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17688
17689# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17690#if defined(MFC_OpenACC)
17691# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17692!$acc parallel loop collapse(3) gang vector default(present)
17693# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17694#elif defined(MFC_OpenMP)
17695# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17696
17697# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17698
17699# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17700
17701# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17702!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17703# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17704#endif
17705 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17706 do k = isy%beg, isy%end
17707 do j = isx%beg, isx%end
17708 dql_prim_dy_vf(i)%sf(j, k, -1) = dqr_prim_dy_vf(i)%sf(j, k, 0)
17709 end do
17710 end do
17711 end do
17712
17713# 3947 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17714#if defined(MFC_OpenACC)
17715# 3947 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17716!$acc end parallel loop
17717# 3947 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17718#elif defined(MFC_OpenMP)
17719# 3947 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17720
17721# 3947 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17722!$omp end target teams loop
17723# 3947 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17724#endif
17725
17726# 3948 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17727
17728# 3948 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17729#if defined(MFC_OpenACC)
17730# 3948 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17731!$acc parallel loop collapse(3) gang vector default(present)
17732# 3948 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17733#elif defined(MFC_OpenMP)
17734# 3948 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17735
17736# 3948 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17737
17738# 3948 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17739
17740# 3948 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17741!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17742# 3948 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17743#endif
17744 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17745 do k = isy%beg, isy%end
17746 do j = isx%beg, isx%end
17747 dql_prim_dz_vf(i)%sf(j, k, -1) = dqr_prim_dz_vf(i)%sf(j, k, 0)
17748 end do
17749 end do
17750 end do
17751
17752# 3956 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17753#if defined(MFC_OpenACC)
17754# 3956 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17755!$acc end parallel loop
17756# 3956 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17757#elif defined(MFC_OpenMP)
17758# 3956 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17759
17760# 3956 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17761!$omp end target teams loop
17762# 3956 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17763#endif
17764 end if
17765 end if
17766
17767 if (bc_z%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
17768
17769
17770# 3962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17771
17772# 3962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17773#if defined(MFC_OpenACC)
17774# 3962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17775!$acc parallel loop collapse(3) gang vector default(present)
17776# 3962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17777#elif defined(MFC_OpenMP)
17778# 3962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17779
17780# 3962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17781
17782# 3962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17783
17784# 3962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17785!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17786# 3962 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17787#endif
17788 do i = 1, sys_size
17789 do l = is3%beg, is3%end
17790 do k = is2%beg, is2%end
17791 qr_prim_rsz_vf(p + 1, k, l, i) = ql_prim_rsz_vf(p, k, l, i)
17792 end do
17793 end do
17794 end do
17795
17796# 3970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17797#if defined(MFC_OpenACC)
17798# 3970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17799!$acc end parallel loop
17800# 3970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17801#elif defined(MFC_OpenMP)
17802# 3970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17803
17804# 3970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17805!$omp end target teams loop
17806# 3970 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17807#endif
17808
17809 if (viscous .or. dummy) then
17810
17811# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17812
17813# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17814#if defined(MFC_OpenACC)
17815# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17816!$acc parallel loop collapse(3) gang vector default(present)
17817# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17818#elif defined(MFC_OpenMP)
17819# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17820
17821# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17822
17823# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17824
17825# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17826!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17827# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17828#endif
17829 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17830 do k = isy%beg, isy%end
17831 do j = isx%beg, isx%end
17832 dqr_prim_dx_vf(i)%sf(j, k, p + 1) = dql_prim_dx_vf(i)%sf(j, k, p)
17833 end do
17834 end do
17835 end do
17836
17837# 3981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17838#if defined(MFC_OpenACC)
17839# 3981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17840!$acc end parallel loop
17841# 3981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17842#elif defined(MFC_OpenMP)
17843# 3981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17844
17845# 3981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17846!$omp end target teams loop
17847# 3981 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17848#endif
17849
17850
17851# 3983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17852
17853# 3983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17854#if defined(MFC_OpenACC)
17855# 3983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17856!$acc parallel loop collapse(3) gang vector default(present)
17857# 3983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17858#elif defined(MFC_OpenMP)
17859# 3983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17860
17861# 3983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17862
17863# 3983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17864
17865# 3983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17866!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17867# 3983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17868#endif
17869 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17870 do k = isy%beg, isy%end
17871 do j = isx%beg, isx%end
17872 dqr_prim_dy_vf(i)%sf(j, k, p + 1) = dql_prim_dy_vf(i)%sf(j, k, p)
17873 end do
17874 end do
17875 end do
17876
17877# 3991 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17878#if defined(MFC_OpenACC)
17879# 3991 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17880!$acc end parallel loop
17881# 3991 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17882#elif defined(MFC_OpenMP)
17883# 3991 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17884
17885# 3991 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17886!$omp end target teams loop
17887# 3991 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17888#endif
17889
17890
17891# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17892
17893# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17894#if defined(MFC_OpenACC)
17895# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17896!$acc parallel loop collapse(3) gang vector default(present)
17897# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17898#elif defined(MFC_OpenMP)
17899# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17900
17901# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17902
17903# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17904
17905# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17906!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17907# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17908#endif
17909 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17910 do k = isy%beg, isy%end
17911 do j = isx%beg, isx%end
17912 dqr_prim_dz_vf(i)%sf(j, k, p + 1) = dql_prim_dz_vf(i)%sf(j, k, p)
17913 end do
17914 end do
17915 end do
17916
17917# 4001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17918#if defined(MFC_OpenACC)
17919# 4001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17920!$acc end parallel loop
17921# 4001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17922#elif defined(MFC_OpenMP)
17923# 4001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17924
17925# 4001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17926!$omp end target teams loop
17927# 4001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17928#endif
17929 end if
17930 end if
17931 end if
17932 ! END: Population of Buffers in z-direction
17933
17934 end subroutine s_populate_riemann_states_variables_buffers
17935
17936 !> Set up the chosen Riemann solver algorithm for the current direction
17937 subroutine s_initialize_riemann_solver(flux_src_vf, norm_dir)
17938
17939 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
17940 integer, intent(in) :: norm_dir
17941 integer :: i, j, k, l !< Generic loop iterators
17942
17943 ! Reshaping Inputted Data in x-direction
17944
17945 if (norm_dir == 1) then
17946 if (viscous .or. (surface_tension) .or. dummy) then
17947
17948# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17949
17950# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17951#if defined(MFC_OpenACC)
17952# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17953!$acc parallel loop collapse(4) gang vector default(present)
17954# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17955#elif defined(MFC_OpenMP)
17956# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17957
17958# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17959
17960# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17961
17962# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17963!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17964# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17965#endif
17966 do i = eqn_idx%mom%beg, eqn_idx%E
17967 do l = is3%beg, is3%end
17968 do k = is2%beg, is2%end
17969 do j = is1%beg, is1%end
17970 flux_src_vf(i)%sf(j, k, l) = 0._wp
17971 end do
17972 end do
17973 end do
17974 end do
17975
17976# 4030 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17977#if defined(MFC_OpenACC)
17978# 4030 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17979!$acc end parallel loop
17980# 4030 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17981#elif defined(MFC_OpenMP)
17982# 4030 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17983
17984# 4030 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17985!$omp end target teams loop
17986# 4030 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17987#endif
17988 end if
17989
17990 if (chem_params%diffusion) then
17991
17992# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17993
17994# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17995#if defined(MFC_OpenACC)
17996# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17997!$acc parallel loop collapse(4) gang vector default(present)
17998# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17999#elif defined(MFC_OpenMP)
18000# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18001
18002# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18003
18004# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18005
18006# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18007!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18008# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18009#endif
18010 do i = eqn_idx%E, eqn_idx%species%end
18011 do l = is3%beg, is3%end
18012 do k = is2%beg, is2%end
18013 do j = is1%beg, is1%end
18014 if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then
18015 flux_src_vf(i)%sf(j, k, l) = 0._wp
18016 end if
18017 end do
18018 end do
18019 end do
18020 end do
18021
18022# 4046 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18023#if defined(MFC_OpenACC)
18024# 4046 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18025!$acc end parallel loop
18026# 4046 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18027#elif defined(MFC_OpenMP)
18028# 4046 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18029
18030# 4046 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18031!$omp end target teams loop
18032# 4046 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18033#endif
18034 end if
18035
18036 if (qbmm) then
18037
18038# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18039
18040# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18041#if defined(MFC_OpenACC)
18042# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18043!$acc parallel loop collapse(4) gang vector default(present)
18044# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18045#elif defined(MFC_OpenMP)
18046# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18047
18048# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18049
18050# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18051
18052# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18053!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18054# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18055#endif
18056 do i = 1, 4
18057 do l = is3%beg, is3%end
18058 do k = is2%beg, is2%end
18059 do j = is1%beg, is1%end + 1
18060 mom_sp_rsx_vf(j, k, l, i) = mom_sp(i)%sf(j, k, l)
18061 end do
18062 end do
18063 end do
18064 end do
18065
18066# 4060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18067#if defined(MFC_OpenACC)
18068# 4060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18069!$acc end parallel loop
18070# 4060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18071#elif defined(MFC_OpenMP)
18072# 4060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18073
18074# 4060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18075!$omp end target teams loop
18076# 4060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18077#endif
18078 end if
18079
18080 ! Reshaping Inputted Data in y-direction
18081 else if (norm_dir == 2) then
18082 if (viscous .or. (surface_tension) .or. dummy) then
18083
18084# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18085
18086# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18087#if defined(MFC_OpenACC)
18088# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18089!$acc parallel loop collapse(4) gang vector default(present)
18090# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18091#elif defined(MFC_OpenMP)
18092# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18093
18094# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18095
18096# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18097
18098# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18099!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18100# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18101#endif
18102 do i = eqn_idx%mom%beg, eqn_idx%E
18103 do l = is3%beg, is3%end
18104 do j = is1%beg, is1%end
18105 do k = is2%beg, is2%end
18106 flux_src_vf(i)%sf(k, j, l) = 0._wp
18107 end do
18108 end do
18109 end do
18110 end do
18111
18112# 4076 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18113#if defined(MFC_OpenACC)
18114# 4076 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18115!$acc end parallel loop
18116# 4076 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18117#elif defined(MFC_OpenMP)
18118# 4076 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18119
18120# 4076 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18121!$omp end target teams loop
18122# 4076 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18123#endif
18124 end if
18125
18126 if (chem_params%diffusion) then
18127
18128# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18129
18130# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18131#if defined(MFC_OpenACC)
18132# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18133!$acc parallel loop collapse(4) gang vector default(present)
18134# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18135#elif defined(MFC_OpenMP)
18136# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18137
18138# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18139
18140# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18141
18142# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18143!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18144# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18145#endif
18146 do i = eqn_idx%E, eqn_idx%species%end
18147 do l = is3%beg, is3%end
18148 do j = is1%beg, is1%end
18149 do k = is2%beg, is2%end
18150 if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then
18151 flux_src_vf(i)%sf(k, j, l) = 0._wp
18152 end if
18153 end do
18154 end do
18155 end do
18156 end do
18157
18158# 4092 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18159#if defined(MFC_OpenACC)
18160# 4092 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18161!$acc end parallel loop
18162# 4092 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18163#elif defined(MFC_OpenMP)
18164# 4092 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18165
18166# 4092 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18167!$omp end target teams loop
18168# 4092 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18169#endif
18170 end if
18171
18172 if (qbmm) then
18173
18174# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18175
18176# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18177#if defined(MFC_OpenACC)
18178# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18179!$acc parallel loop collapse(4) gang vector default(present)
18180# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18181#elif defined(MFC_OpenMP)
18182# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18183
18184# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18185
18186# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18187
18188# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18189!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18190# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18191#endif
18192 do i = 1, 4
18193 do l = is3%beg, is3%end
18194 do k = is2%beg, is2%end
18195 do j = is1%beg, is1%end + 1
18196 mom_sp_rsy_vf(j, k, l, i) = mom_sp(i)%sf(k, j, l)
18197 end do
18198 end do
18199 end do
18200 end do
18201
18202# 4106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18203#if defined(MFC_OpenACC)
18204# 4106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18205!$acc end parallel loop
18206# 4106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18207#elif defined(MFC_OpenMP)
18208# 4106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18209
18210# 4106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18211!$omp end target teams loop
18212# 4106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18213#endif
18214 end if
18215
18216 ! Reshaping Inputted Data in z-direction
18217 else
18218 if (viscous .or. (surface_tension) .or. dummy) then
18219
18220# 4112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18221
18222# 4112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18223#if defined(MFC_OpenACC)
18224# 4112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18225!$acc parallel loop collapse(4) gang vector default(present)
18226# 4112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18227#elif defined(MFC_OpenMP)
18228# 4112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18229
18230# 4112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18231
18232# 4112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18233
18234# 4112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18235!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18236# 4112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18237#endif
18238 do i = eqn_idx%mom%beg, eqn_idx%E
18239 do j = is1%beg, is1%end
18240 do k = is2%beg, is2%end
18241 do l = is3%beg, is3%end
18242 flux_src_vf(i)%sf(l, k, j) = 0._wp
18243 end do
18244 end do
18245 end do
18246 end do
18247
18248# 4122 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18249#if defined(MFC_OpenACC)
18250# 4122 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18251!$acc end parallel loop
18252# 4122 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18253#elif defined(MFC_OpenMP)
18254# 4122 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18255
18256# 4122 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18257!$omp end target teams loop
18258# 4122 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18259#endif
18260 end if
18261
18262 if (chem_params%diffusion) then
18263
18264# 4126 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18265
18266# 4126 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18267#if defined(MFC_OpenACC)
18268# 4126 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18269!$acc parallel loop collapse(4) gang vector default(present)
18270# 4126 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18271#elif defined(MFC_OpenMP)
18272# 4126 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18273
18274# 4126 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18275
18276# 4126 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18277
18278# 4126 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18279!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18280# 4126 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18281#endif
18282 do i = eqn_idx%E, eqn_idx%species%end
18283 do j = is1%beg, is1%end
18284 do k = is2%beg, is2%end
18285 do l = is3%beg, is3%end
18286 if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then
18287 flux_src_vf(i)%sf(l, k, j) = 0._wp
18288 end if
18289 end do
18290 end do
18291 end do
18292 end do
18293
18294# 4138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18295#if defined(MFC_OpenACC)
18296# 4138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18297!$acc end parallel loop
18298# 4138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18299#elif defined(MFC_OpenMP)
18300# 4138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18301
18302# 4138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18303!$omp end target teams loop
18304# 4138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18305#endif
18306 end if
18307
18308 if (qbmm) then
18309
18310# 4142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18311
18312# 4142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18313#if defined(MFC_OpenACC)
18314# 4142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18315!$acc parallel loop collapse(4) gang vector default(present)
18316# 4142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18317#elif defined(MFC_OpenMP)
18318# 4142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18319
18320# 4142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18321
18322# 4142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18323
18324# 4142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18325!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18326# 4142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18327#endif
18328 do i = 1, 4
18329 do l = is3%beg, is3%end
18330 do k = is2%beg, is2%end
18331 do j = is1%beg, is1%end + 1
18332 mom_sp_rsz_vf(j, k, l, i) = mom_sp(i)%sf(l, k, j)
18333 end do
18334 end do
18335 end do
18336 end do
18337
18338# 4152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18339#if defined(MFC_OpenACC)
18340# 4152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18341!$acc end parallel loop
18342# 4152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18343#elif defined(MFC_OpenMP)
18344# 4152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18345
18346# 4152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18347!$omp end target teams loop
18348# 4152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18349#endif
18350 end if
18351 end if
18352
18353 end subroutine s_initialize_riemann_solver
18354
18355 !> Compute cylindrical viscous source flux contributions for momentum and energy
18356 subroutine s_compute_cylindrical_viscous_source_flux(velL_vf, dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, velR_vf, dvelR_dx_vf, &
18357
18358 & dvelR_dy_vf, dvelR_dz_vf, flux_src_vf, norm_dir, ix, iy, iz)
18359
18360 type(scalar_field), dimension(num_dims), intent(in) :: velL_vf, velR_vf
18361 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
18362 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
18363 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
18364 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
18365 integer, intent(in) :: norm_dir
18366 type(int_bounds_info), intent(in) :: ix, iy, iz
18367
18368 ! Local variables
18369
18370# 4183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18371 real(wp), dimension(num_dims) :: avg_v_int !< Averaged interface velocity (\f$v_x, v_y, v_z\f$) (grid directions).
18372 real(wp), dimension(num_dims) :: avg_dvdx_int !< Averaged interface \f$\partial v_i/\partial x\f$ (grid dir 1).
18373 real(wp), dimension(num_dims) :: avg_dvdy_int !< Averaged interface \f$\partial v_i/\partial y\f$ (grid dir 2).
18374 real(wp), dimension(num_dims) :: avg_dvdz_int !< Averaged interface \f$\partial v_i/\partial z\f$ (grid dir 3).
18375 !> Interface velocity (\f$v_1,v_2,v_3\f$) (grid directions) for viscous work.
18376 real(wp), dimension(num_dims) :: vel_src_int
18377 !> Shear stress vector (\f$\sigma_{N1}, \sigma_{N2}, \sigma_{N3}\f$) on N-face (grid directions).
18378 real(wp), dimension(num_dims) :: stress_vector_shear
18379# 4192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18380 real(wp) :: stress_normal_bulk !< Normal bulk stress component \f$\sigma_{NN}\f$ on N-face.
18381 real(wp) :: Re_s, Re_b !< Effective interface shear and bulk Reynolds numbers.
18382 real(wp) :: r_eff !< Effective radius at interface for cylindrical terms.
18383 real(wp) :: div_v_term_const !< Common term \f$-(2/3)(\nabla \cdot \mathbf{v}) / \text{Re}_s\f$ for shear stress diagonal.
18384 real(wp) :: divergence_cyl !< Full divergence \f$\nabla \cdot \mathbf{v}\f$ in cylindrical coordinates.
18385 integer :: j, k, l !< Loop iterators for \f$x, y, z\f$ grid directions.
18386 integer :: i_vel !< Loop iterator for velocity components.
18387 integer :: idx_rp(3) !< Indices \f$(j,k,l)\f$ of 'right' point for averaging.
18388
18389
18390# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18391
18392# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18393#if defined(MFC_OpenACC)
18394# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18395!$acc parallel loop collapse(3) gang vector default(present) private(idx_rp, avg_v_int, avg_dvdx_int, avg_dvdy_int, avg_dvdz_int, Re_s, Re_b, vel_src_int, r_eff, divergence_cyl, stress_vector_shear, stress_normal_bulk, div_v_term_const)
18396# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18397#elif defined(MFC_OpenMP)
18398# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18399
18400# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18401
18402# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18403
18404# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18405!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(idx_rp, avg_v_int, avg_dvdx_int, avg_dvdy_int, avg_dvdz_int, Re_s, Re_b, vel_src_int, r_eff, divergence_cyl, stress_vector_shear, stress_normal_bulk, div_v_term_const)
18406# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18407#endif
18408# 4203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18409 do l = iz%beg, iz%end
18410 do k = iy%beg, iy%end
18411 do j = ix%beg, ix%end
18412 ! Determine indices for the 'right' state for averaging across the interface
18413 idx_rp = [j, k, l]
18414 idx_rp(norm_dir) = idx_rp(norm_dir) + 1
18415
18416 ! Average velocities and their derivatives at the interface For cylindrical: x-dir ~ axial (z_cyl), y-dir ~
18417 ! radial (r_cyl), z-dir ~ azimuthal (theta_cyl)
18418
18419# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18420#if defined(MFC_OpenACC)
18421# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18422!$acc loop seq
18423# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18424#elif defined(MFC_OpenMP)
18425# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18426
18427# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18428#endif
18429 do i_vel = 1, num_dims
18430 avg_v_int(i_vel) = 0.5_wp*(vell_vf(i_vel)%sf(j, k, l) + velr_vf(i_vel)%sf(idx_rp(1), idx_rp(2), idx_rp(3)))
18431
18432 avg_dvdx_int(i_vel) = 0.5_wp*(dvell_dx_vf(i_vel)%sf(j, k, l) + dvelr_dx_vf(i_vel)%sf(idx_rp(1), &
18433 & idx_rp(2), idx_rp(3)))
18434 if (num_dims > 1) then
18435 avg_dvdy_int(i_vel) = 0.5_wp*(dvell_dy_vf(i_vel)%sf(j, k, l) + dvelr_dy_vf(i_vel)%sf(idx_rp(1), &
18436 & idx_rp(2), idx_rp(3)))
18437 else
18438 avg_dvdy_int(i_vel) = 0.0_wp
18439 end if
18440 if (num_dims > 2) then
18441 avg_dvdz_int(i_vel) = 0.5_wp*(dvell_dz_vf(i_vel)%sf(j, k, l) + dvelr_dz_vf(i_vel)%sf(idx_rp(1), &
18442 & idx_rp(2), idx_rp(3)))
18443 else
18444 avg_dvdz_int(i_vel) = 0.0_wp
18445 end if
18446 end do
18447
18448 ! Get Re numbers and interface velocity for viscous work
18449 select case (norm_dir)
18450 case (1) ! x-face (axial face in z_cyl direction)
18451 re_s = re_avg_rsx_vf(j, k, l, 1)
18452 re_b = re_avg_rsx_vf(j, k, l, 2)
18453 vel_src_int = vel_src_rsx_vf(j, k, l,1:num_dims)
18454 r_eff = y_cc(k)
18455 case (2) ! y-face (radial face in r_cyl direction)
18456 re_s = re_avg_rsy_vf(k, j, l, 1)
18457 re_b = re_avg_rsy_vf(k, j, l, 2)
18458 vel_src_int = vel_src_rsy_vf(k, j, l,1:num_dims)
18459 r_eff = y_cb(k)
18460 case (3) ! z-face (azimuthal face in theta_cyl direction)
18461 re_s = re_avg_rsz_vf(l, k, j, 1)
18462 re_b = re_avg_rsz_vf(l, k, j, 2)
18463 vel_src_int = vel_src_rsz_vf(l, k, j,1:num_dims)
18464 r_eff = y_cc(k)
18465 end select
18466
18467 ! Divergence in cylindrical coordinates (vx=vz_cyl, vy=vr_cyl, vz=vtheta_cyl)
18468# 4253 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18469 divergence_cyl = avg_dvdx_int(1) + avg_dvdy_int(2) + avg_v_int(2)/r_eff
18470 if (num_dims > 2) then
18471# 4256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18472 divergence_cyl = divergence_cyl + avg_dvdz_int(3)/r_eff
18473# 4258 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18474 end if
18475# 4260 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18476
18477 stress_vector_shear = 0.0_wp
18478 stress_normal_bulk = 0.0_wp
18479
18480 if (shear_stress) then
18481 div_v_term_const = -(2.0_wp/3.0_wp)*divergence_cyl/re_s
18482
18483 select case (norm_dir)
18484 case (1) ! X-face (axial normal, z_cyl)
18485 stress_vector_shear(1) = (2.0_wp*avg_dvdx_int(1))/re_s + div_v_term_const
18486 if (num_dims > 1) then
18487# 4272 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18488 stress_vector_shear(2) = (avg_dvdy_int(1) + avg_dvdx_int(2))/re_s
18489# 4274 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18490 end if
18491 if (num_dims > 2) then
18492# 4277 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18493 stress_vector_shear(3) = (avg_dvdz_int(1)/r_eff + avg_dvdx_int(3))/re_s
18494# 4279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18495 end if
18496 case (2) ! Y-face (radial normal, r_cyl)
18497 if (num_dims > 1) then
18498# 4283 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18499 stress_vector_shear(1) = (avg_dvdy_int(1) + avg_dvdx_int(2))/re_s
18500 stress_vector_shear(2) = (2.0_wp*avg_dvdy_int(2))/re_s + div_v_term_const
18501 if (num_dims > 2) then
18502# 4287 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18503 stress_vector_shear(3) = (avg_dvdz_int(2)/r_eff - avg_v_int(3)/r_eff + avg_dvdy_int(3) &
18504 & )/re_s
18505# 4290 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18506 end if
18507# 4292 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18508 else
18509 stress_vector_shear(1) = (2.0_wp*avg_dvdx_int(1))/re_s + div_v_term_const
18510 end if
18511 case (3) ! Z-face (azimuthal normal, theta_cyl)
18512 if (num_dims > 2) then
18513# 4298 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18514 stress_vector_shear(1) = (avg_dvdz_int(1)/r_eff + avg_dvdx_int(3))/re_s
18515 stress_vector_shear(2) = (avg_dvdz_int(2)/r_eff - avg_v_int(3)/r_eff + avg_dvdy_int(3))/re_s
18516 stress_vector_shear(3) = (2.0_wp*(avg_dvdz_int(3)/r_eff + avg_v_int(2)/r_eff))/re_s &
18517 & + div_v_term_const
18518# 4303 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18519 end if
18520 end select
18521
18522
18523# 4306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18524#if defined(MFC_OpenACC)
18525# 4306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18526!$acc loop seq
18527# 4306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18528#elif defined(MFC_OpenMP)
18529# 4306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18530
18531# 4306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18532#endif
18533 do i_vel = 1, num_dims
18534 flux_src_vf(eqn_idx%mom%beg + i_vel - 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + i_vel - 1)%sf(j, &
18535 & k, l) - stress_vector_shear(i_vel)
18536 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
18537 & l) - vel_src_int(i_vel)*stress_vector_shear(i_vel)
18538 end do
18539 end if
18540
18541 if (bulk_stress) then
18542 stress_normal_bulk = divergence_cyl/re_b
18543
18544 flux_src_vf(eqn_idx%mom%beg + norm_dir - 1)%sf(j, k, &
18545 & l) = flux_src_vf(eqn_idx%mom%beg + norm_dir - 1)%sf(j, k, l) - stress_normal_bulk
18546 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
18547 & l) - vel_src_int(norm_dir)*stress_normal_bulk
18548 end if
18549 end do
18550 end do
18551 end do
18552
18553# 4326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18554#if defined(MFC_OpenACC)
18555# 4326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18556!$acc end parallel loop
18557# 4326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18558#elif defined(MFC_OpenMP)
18559# 4326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18560
18561# 4326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18562!$omp end target teams loop
18563# 4326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18564#endif
18565
18566 end subroutine s_compute_cylindrical_viscous_source_flux
18567
18568 !> Compute Cartesian viscous source flux contributions for momentum and energy
18569 subroutine s_compute_cartesian_viscous_source_flux(dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, dvelR_dx_vf, dvelR_dy_vf, &
18570
18571 & dvelR_dz_vf, flux_src_vf, norm_dir)
18572
18573 ! Arguments
18574 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
18575 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
18576 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
18577 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
18578 integer, intent(in) :: norm_dir
18579
18580 ! Local variables
18581
18582# 4350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18583 real(wp), dimension(num_dims, num_dims) :: vel_grad_avg !< Averaged velocity gradient tensor `d(vel_i)/d(coord_j)`.
18584 real(wp), dimension(num_dims, num_dims) :: current_tau_shear !< Current shear stress tensor.
18585 real(wp), dimension(num_dims, num_dims) :: current_tau_bulk !< Current bulk stress tensor.
18586 real(wp), dimension(num_dims) :: vel_src_at_interface !< Interface velocities (u,v,w) for viscous work.
18587# 4355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18588 integer, dimension(3) :: idx_right_phys !< Physical (j,k,l) indices for right state.
18589 real(wp) :: Re_shear !< Interface shear Reynolds number.
18590 real(wp) :: Re_bulk !< Interface bulk Reynolds number.
18591 integer :: j_loop !< Physical x-index loop iterator.
18592 integer :: k_loop !< Physical y-index loop iterator.
18593 integer :: l_loop !< Physical z-index loop iterator.
18594 integer :: i_dim !< Generic dimension/component iterator.
18595 integer :: vel_comp_idx !< Velocity component iterator (1=u, 2=v, 3=w).
18596 real(wp) :: divergence_v !< Velocity divergence at interface.
18597
18598
18599# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18600
18601# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18602#if defined(MFC_OpenACC)
18603# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18604!$acc parallel loop collapse(3) gang vector default(present) private(idx_right_phys, vel_grad_avg, current_tau_shear, current_tau_bulk, vel_src_at_interface, Re_shear, Re_bulk, divergence_v, i_dim, vel_comp_idx)
18605# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18606#elif defined(MFC_OpenMP)
18607# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18608
18609# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18610
18611# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18612
18613# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18614!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(idx_right_phys, vel_grad_avg, current_tau_shear, current_tau_bulk, vel_src_at_interface, Re_shear, Re_bulk, divergence_v, i_dim, vel_comp_idx)
18615# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18616#endif
18617# 4367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18618 do l_loop = isz%beg, isz%end
18619 do k_loop = isy%beg, isy%end
18620 do j_loop = isx%beg, isx%end
18621 idx_right_phys(1) = j_loop
18622 idx_right_phys(2) = k_loop
18623 idx_right_phys(3) = l_loop
18624 idx_right_phys(norm_dir) = idx_right_phys(norm_dir) + 1
18625
18626 vel_grad_avg = 0.0_wp
18627 do vel_comp_idx = 1, num_dims
18628 vel_grad_avg(vel_comp_idx, 1) = 0.5_wp*(dvell_dx_vf(vel_comp_idx)%sf(j_loop, k_loop, &
18629 & l_loop) + dvelr_dx_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), &
18630 & idx_right_phys(3)))
18631 if (num_dims > 1) then
18632# 4382 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18633 vel_grad_avg(vel_comp_idx, 2) = 0.5_wp*(dvell_dy_vf(vel_comp_idx)%sf(j_loop, k_loop, &
18634 & l_loop) + dvelr_dy_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), &
18635 & idx_right_phys(3)))
18636# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18637 end if
18638 if (num_dims > 2) then
18639# 4389 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18640 vel_grad_avg(vel_comp_idx, 3) = 0.5_wp*(dvell_dz_vf(vel_comp_idx)%sf(j_loop, k_loop, &
18641 & l_loop) + dvelr_dz_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), &
18642 & idx_right_phys(3)))
18643# 4393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18644 end if
18645 end do
18646
18647 divergence_v = 0.0_wp
18648 do i_dim = 1, num_dims
18649 divergence_v = divergence_v + vel_grad_avg(i_dim, i_dim)
18650 end do
18651
18652 vel_src_at_interface = 0.0_wp
18653 if (norm_dir == 1) then
18654 re_shear = re_avg_rsx_vf(j_loop, k_loop, l_loop, 1)
18655 re_bulk = re_avg_rsx_vf(j_loop, k_loop, l_loop, 2)
18656 do i_dim = 1, num_dims
18657 vel_src_at_interface(i_dim) = vel_src_rsx_vf(j_loop, k_loop, l_loop, i_dim)
18658 end do
18659 else if (norm_dir == 2) then
18660 re_shear = re_avg_rsy_vf(k_loop, j_loop, l_loop, 1)
18661 re_bulk = re_avg_rsy_vf(k_loop, j_loop, l_loop, 2)
18662 do i_dim = 1, num_dims
18663 vel_src_at_interface(i_dim) = vel_src_rsy_vf(k_loop, j_loop, l_loop, i_dim)
18664 end do
18665 else
18666 re_shear = re_avg_rsz_vf(l_loop, k_loop, j_loop, 1)
18667 re_bulk = re_avg_rsz_vf(l_loop, k_loop, j_loop, 2)
18668 do i_dim = 1, num_dims
18669 vel_src_at_interface(i_dim) = vel_src_rsz_vf(l_loop, k_loop, j_loop, i_dim)
18670 end do
18671 end if
18672
18673 if (shear_stress) then
18674 ! current_tau_shear = 0.0_wp
18675 call s_calculate_shear_stress_tensor(vel_grad_avg, re_shear, divergence_v, current_tau_shear)
18676
18677 do i_dim = 1, num_dims
18678 flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
18679 & l_loop) = flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
18680 & l_loop) - current_tau_shear(norm_dir, i_dim)
18681
18682 flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, &
18683 & l_loop) - vel_src_at_interface(i_dim)*current_tau_shear(norm_dir, i_dim)
18684 end do
18685 end if
18686
18687 if (bulk_stress) then
18688 ! current_tau_bulk = 0.0_wp
18689 call s_calculate_bulk_stress_tensor(re_bulk, divergence_v, current_tau_bulk)
18690
18691 do i_dim = 1, num_dims
18692 flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
18693 & l_loop) = flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
18694 & l_loop) - current_tau_bulk(norm_dir, i_dim)
18695
18696 flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, &
18697 & l_loop) - vel_src_at_interface(i_dim)*current_tau_bulk(norm_dir, i_dim)
18698 end do
18699 end if
18700 end do
18701 end do
18702 end do
18703
18704# 4452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18705#if defined(MFC_OpenACC)
18706# 4452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18707!$acc end parallel loop
18708# 4452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18709#elif defined(MFC_OpenMP)
18710# 4452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18711
18712# 4452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18713!$omp end target teams loop
18714# 4452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18715#endif
18716
18717 end subroutine s_compute_cartesian_viscous_source_flux
18718
18719 !> Compute shear stress tensor components
18720 subroutine s_calculate_shear_stress_tensor(vel_grad_avg, Re_shear, divergence_v, tau_shear_out)
18721
18722
18723# 4459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18724#if MFC_OpenACC
18725# 4459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18726!$acc routine seq
18727# 4459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18728#elif MFC_OpenMP
18729# 4459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18730
18731# 4459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18732
18733# 4459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18734!$omp declare target device_type(any)
18735# 4459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18736#endif
18737
18738 ! Arguments
18739# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18740 real(wp), dimension(num_dims, num_dims), intent(in) :: vel_grad_avg
18741 real(wp), dimension(num_dims, num_dims), intent(out) :: tau_shear_out
18742# 4469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18743 real(wp), intent(in) :: Re_shear
18744 real(wp), intent(in) :: divergence_v
18745
18746 ! Local variables
18747 integer :: i_dim !< Loop iterator for face normal.
18748 integer :: j_dim !< Loop iterator for force component direction.
18749 tau_shear_out = 0.0_wp
18750
18751 do i_dim = 1, num_dims
18752 do j_dim = 1, num_dims
18753 tau_shear_out(i_dim, j_dim) = (vel_grad_avg(j_dim, i_dim) + vel_grad_avg(i_dim, j_dim))/re_shear
18754 if (i_dim == j_dim) then
18755 tau_shear_out(i_dim, j_dim) = tau_shear_out(i_dim, j_dim) - (2.0_wp/3.0_wp)*divergence_v/re_shear
18756 end if
18757 end do
18758 end do
18759
18760 end subroutine s_calculate_shear_stress_tensor
18761
18762 !> Compute bulk stress tensor components (diagonal only)
18763 subroutine s_calculate_bulk_stress_tensor(Re_bulk, divergence_v, tau_bulk_out)
18764
18765
18766# 4491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18767#if MFC_OpenACC
18768# 4491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18769!$acc routine seq
18770# 4491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18771#elif MFC_OpenMP
18772# 4491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18773
18774# 4491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18775
18776# 4491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18777!$omp declare target device_type(any)
18778# 4491 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18779#endif
18780
18781 ! Arguments
18782 real(wp), intent(in) :: Re_bulk
18783 real(wp), intent(in) :: divergence_v
18784# 4499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18785 real(wp), dimension(num_dims, num_dims), intent(out) :: tau_bulk_out
18786# 4501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18787
18788 ! Local variables
18789 integer :: i_dim !< Loop iterator for diagonal components.
18790 tau_bulk_out = 0.0_wp
18791
18792 do i_dim = 1, num_dims
18793 tau_bulk_out(i_dim, i_dim) = divergence_v/re_bulk
18794 end do
18795
18796 end subroutine s_calculate_bulk_stress_tensor
18797
18798 !> Deallocation and/or disassociation procedures that are needed to finalize the selected Riemann problem solver
18799 subroutine s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
18800
18801 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
18802 integer, intent(in) :: norm_dir
18803 integer :: i, j, k, l !< Generic loop iterators
18804 ! Reshaping Outputted Data in y-direction
18805
18806 if (norm_dir == 2) then
18807
18808# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18809
18810# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18811#if defined(MFC_OpenACC)
18812# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18813!$acc parallel loop collapse(4) gang vector default(present)
18814# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18815#elif defined(MFC_OpenMP)
18816# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18817
18818# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18819
18820# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18821
18822# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18823!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18824# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18825#endif
18826 do i = 1, sys_size
18827 do l = is3%beg, is3%end
18828 do j = is1%beg, is1%end
18829 do k = is2%beg, is2%end
18830 flux_vf(i)%sf(k, j, l) = flux_rsy_vf(j, k, l, i)
18831 end do
18832 end do
18833 end do
18834 end do
18835
18836# 4531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18837#if defined(MFC_OpenACC)
18838# 4531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18839!$acc end parallel loop
18840# 4531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18841#elif defined(MFC_OpenMP)
18842# 4531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18843
18844# 4531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18845!$omp end target teams loop
18846# 4531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18847#endif
18848
18849 if (cyl_coord) then
18850
18851# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18852
18853# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18854#if defined(MFC_OpenACC)
18855# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18856!$acc parallel loop collapse(4) gang vector default(present)
18857# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18858#elif defined(MFC_OpenMP)
18859# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18860
18861# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18862
18863# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18864
18865# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18866!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18867# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18868#endif
18869 do i = 1, sys_size
18870 do l = is3%beg, is3%end
18871 do j = is1%beg, is1%end
18872 do k = is2%beg, is2%end
18873 flux_gsrc_vf(i)%sf(k, j, l) = flux_gsrc_rsy_vf(j, k, l, i)
18874 end do
18875 end do
18876 end do
18877 end do
18878
18879# 4544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18880#if defined(MFC_OpenACC)
18881# 4544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18882!$acc end parallel loop
18883# 4544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18884#elif defined(MFC_OpenMP)
18885# 4544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18886
18887# 4544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18888!$omp end target teams loop
18889# 4544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18890#endif
18891 end if
18892
18893
18894# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18895
18896# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18897#if defined(MFC_OpenACC)
18898# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18899!$acc parallel loop collapse(3) gang vector default(present)
18900# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18901#elif defined(MFC_OpenMP)
18902# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18903
18904# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18905
18906# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18907
18908# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18909!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18910# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18911#endif
18912 do l = is3%beg, is3%end
18913 do j = is1%beg, is1%end
18914 do k = is2%beg, is2%end
18915 flux_src_vf(eqn_idx%adv%beg)%sf(k, j, l) = flux_src_rsy_vf(j, k, l, eqn_idx%adv%beg)
18916 end do
18917 end do
18918 end do
18919
18920# 4555 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18921#if defined(MFC_OpenACC)
18922# 4555 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18923!$acc end parallel loop
18924# 4555 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18925#elif defined(MFC_OpenMP)
18926# 4555 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18927
18928# 4555 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18929!$omp end target teams loop
18930# 4555 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18931#endif
18932
18933 if (riemann_solver == 1 .or. riemann_solver == 4) then
18934
18935# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18936
18937# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18938#if defined(MFC_OpenACC)
18939# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18940!$acc parallel loop collapse(4) gang vector default(present)
18941# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18942#elif defined(MFC_OpenMP)
18943# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18944
18945# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18946
18947# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18948
18949# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18950!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18951# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18952#endif
18953 do i = eqn_idx%adv%beg + 1, eqn_idx%adv%end
18954 do l = is3%beg, is3%end
18955 do j = is1%beg, is1%end
18956 do k = is2%beg, is2%end
18957 flux_src_vf(i)%sf(k, j, l) = flux_src_rsy_vf(j, k, l, i)
18958 end do
18959 end do
18960 end do
18961 end do
18962
18963# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18964#if defined(MFC_OpenACC)
18965# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18966!$acc end parallel loop
18967# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18968#elif defined(MFC_OpenMP)
18969# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18970
18971# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18972!$omp end target teams loop
18973# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18974#endif
18975 end if
18976 ! Reshaping Outputted Data in z-direction
18977 else if (norm_dir == 3) then
18978
18979# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18980
18981# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18982#if defined(MFC_OpenACC)
18983# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18984!$acc parallel loop collapse(4) gang vector default(present)
18985# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18986#elif defined(MFC_OpenMP)
18987# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18988
18989# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18990
18991# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18992
18993# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18994!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18995# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18996#endif
18997 do i = 1, sys_size
18998 do j = is1%beg, is1%end
18999 do k = is2%beg, is2%end
19000 do l = is3%beg, is3%end
19001 flux_vf(i)%sf(l, k, j) = flux_rsz_vf(j, k, l, i)
19002 end do
19003 end do
19004 end do
19005 end do
19006
19007# 4582 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19008#if defined(MFC_OpenACC)
19009# 4582 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19010!$acc end parallel loop
19011# 4582 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19012#elif defined(MFC_OpenMP)
19013# 4582 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19014
19015# 4582 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19016!$omp end target teams loop
19017# 4582 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19018#endif
19019 if (grid_geometry == 3) then
19020
19021# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19022
19023# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19024#if defined(MFC_OpenACC)
19025# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19026!$acc parallel loop collapse(4) gang vector default(present)
19027# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19028#elif defined(MFC_OpenMP)
19029# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19030
19031# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19032
19033# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19034
19035# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19036!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19037# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19038#endif
19039 do i = 1, sys_size
19040 do j = is1%beg, is1%end
19041 do k = is2%beg, is2%end
19042 do l = is3%beg, is3%end
19043 flux_gsrc_vf(i)%sf(l, k, j) = flux_gsrc_rsz_vf(j, k, l, i)
19044 end do
19045 end do
19046 end do
19047 end do
19048
19049# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19050#if defined(MFC_OpenACC)
19051# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19052!$acc end parallel loop
19053# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19054#elif defined(MFC_OpenMP)
19055# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19056
19057# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19058!$omp end target teams loop
19059# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19060#endif
19061 end if
19062
19063
19064# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19065
19066# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19067#if defined(MFC_OpenACC)
19068# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19069!$acc parallel loop collapse(3) gang vector default(present)
19070# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19071#elif defined(MFC_OpenMP)
19072# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19073
19074# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19075
19076# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19077
19078# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19079!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19080# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19081#endif
19082 do j = is1%beg, is1%end
19083 do k = is2%beg, is2%end
19084 do l = is3%beg, is3%end
19085 flux_src_vf(eqn_idx%adv%beg)%sf(l, k, j) = flux_src_rsz_vf(j, k, l, eqn_idx%adv%beg)
19086 end do
19087 end do
19088 end do
19089
19090# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19091#if defined(MFC_OpenACC)
19092# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19093!$acc end parallel loop
19094# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19095#elif defined(MFC_OpenMP)
19096# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19097
19098# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19099!$omp end target teams loop
19100# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19101#endif
19102
19103 if (riemann_solver == 1 .or. riemann_solver == 4) then
19104
19105# 4608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19106
19107# 4608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19108#if defined(MFC_OpenACC)
19109# 4608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19110!$acc parallel loop collapse(4) gang vector default(present)
19111# 4608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19112#elif defined(MFC_OpenMP)
19113# 4608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19114
19115# 4608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19116
19117# 4608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19118
19119# 4608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19120!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19121# 4608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19122#endif
19123 do i = eqn_idx%adv%beg + 1, eqn_idx%adv%end
19124 do j = is1%beg, is1%end
19125 do k = is2%beg, is2%end
19126 do l = is3%beg, is3%end
19127 flux_src_vf(i)%sf(l, k, j) = flux_src_rsz_vf(j, k, l, i)
19128 end do
19129 end do
19130 end do
19131 end do
19132
19133# 4618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19134#if defined(MFC_OpenACC)
19135# 4618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19136!$acc end parallel loop
19137# 4618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19138#elif defined(MFC_OpenMP)
19139# 4618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19140
19141# 4618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19142!$omp end target teams loop
19143# 4618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19144#endif
19145 end if
19146 else if (norm_dir == 1) then
19147
19148# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19149
19150# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19151#if defined(MFC_OpenACC)
19152# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19153!$acc parallel loop collapse(4) gang vector default(present)
19154# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19155#elif defined(MFC_OpenMP)
19156# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19157
19158# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19159
19160# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19161
19162# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19163!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19164# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19165#endif
19166 do i = 1, sys_size
19167 do l = is3%beg, is3%end
19168 do k = is2%beg, is2%end
19169 do j = is1%beg, is1%end
19170 flux_vf(i)%sf(j, k, l) = flux_rsx_vf(j, k, l, i)
19171 end do
19172 end do
19173 end do
19174 end do
19175
19176# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19177#if defined(MFC_OpenACC)
19178# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19179!$acc end parallel loop
19180# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19181#elif defined(MFC_OpenMP)
19182# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19183
19184# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19185!$omp end target teams loop
19186# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19187#endif
19188
19189
19190# 4633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19191
19192# 4633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19193#if defined(MFC_OpenACC)
19194# 4633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19195!$acc parallel loop collapse(3) gang vector default(present)
19196# 4633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19197#elif defined(MFC_OpenMP)
19198# 4633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19199
19200# 4633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19201
19202# 4633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19203
19204# 4633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19205!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19206# 4633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19207#endif
19208 do l = is3%beg, is3%end
19209 do k = is2%beg, is2%end
19210 do j = is1%beg, is1%end
19211 flux_src_vf(eqn_idx%adv%beg)%sf(j, k, l) = flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg)
19212 end do
19213 end do
19214 end do
19215
19216# 4641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19217#if defined(MFC_OpenACC)
19218# 4641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19219!$acc end parallel loop
19220# 4641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19221#elif defined(MFC_OpenMP)
19222# 4641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19223
19224# 4641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19225!$omp end target teams loop
19226# 4641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19227#endif
19228
19229 if (riemann_solver == 1 .or. riemann_solver == 4) then
19230
19231# 4644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19232
19233# 4644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19234#if defined(MFC_OpenACC)
19235# 4644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19236!$acc parallel loop collapse(4) gang vector default(present)
19237# 4644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19238#elif defined(MFC_OpenMP)
19239# 4644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19240
19241# 4644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19242
19243# 4644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19244
19245# 4644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19246!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19247# 4644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19248#endif
19249 do i = eqn_idx%adv%beg + 1, eqn_idx%adv%end
19250 do l = is3%beg, is3%end
19251 do k = is2%beg, is2%end
19252 do j = is1%beg, is1%end
19253 flux_src_vf(i)%sf(j, k, l) = flux_src_rsx_vf(j, k, l, i)
19254 end do
19255 end do
19256 end do
19257 end do
19258
19259# 4654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19260#if defined(MFC_OpenACC)
19261# 4654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19262!$acc end parallel loop
19263# 4654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19264#elif defined(MFC_OpenMP)
19265# 4654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19266
19267# 4654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19268!$omp end target teams loop
19269# 4654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19270#endif
19271 end if
19272 end if
19273
19274 end subroutine s_finalize_riemann_solver
19275
19276 !> Module deallocation and/or disassociation procedures
19277 impure subroutine s_finalize_riemann_solvers_module
19278
19279 if (viscous) then
19280#ifdef MFC_DEBUG
19281# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19282 block
19283# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19284 use iso_fortran_env, only: output_unit
19285# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19286
19287# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19288 print *, 'm_riemann_solvers.fpp:4664: ', '@:DEALLOCATE(Re_avg_rsx_vf)'
19289# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19290
19291# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19292 call flush (output_unit)
19293# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19294 end block
19295# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19296#endif
19297# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19298
19299# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19300#if defined(MFC_OpenACC)
19301# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19302!$acc exit data delete(Re_avg_rsx_vf)
19303# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19304#elif defined(MFC_OpenMP)
19305# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19306!$omp target exit data map(release:Re_avg_rsx_vf)
19307# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19308#endif
19309# 4664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19310 deallocate (re_avg_rsx_vf)
19311 end if
19312#ifdef MFC_DEBUG
19313# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19314 block
19315# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19316 use iso_fortran_env, only: output_unit
19317# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19318
19319# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19320 print *, 'm_riemann_solvers.fpp:4666: ', '@:DEALLOCATE(vel_src_rsx_vf)'
19321# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19322
19323# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19324 call flush (output_unit)
19325# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19326 end block
19327# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19328#endif
19329# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19330
19331# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19332#if defined(MFC_OpenACC)
19333# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19334!$acc exit data delete(vel_src_rsx_vf)
19335# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19336#elif defined(MFC_OpenMP)
19337# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19338!$omp target exit data map(release:vel_src_rsx_vf)
19339# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19340#endif
19341# 4666 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19342 deallocate (vel_src_rsx_vf)
19343#ifdef MFC_DEBUG
19344# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19345 block
19346# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19347 use iso_fortran_env, only: output_unit
19348# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19349
19350# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19351 print *, 'm_riemann_solvers.fpp:4667: ', '@:DEALLOCATE(flux_rsx_vf)'
19352# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19353
19354# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19355 call flush (output_unit)
19356# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19357 end block
19358# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19359#endif
19360# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19361
19362# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19363#if defined(MFC_OpenACC)
19364# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19365!$acc exit data delete(flux_rsx_vf)
19366# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19367#elif defined(MFC_OpenMP)
19368# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19369!$omp target exit data map(release:flux_rsx_vf)
19370# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19371#endif
19372# 4667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19373 deallocate (flux_rsx_vf)
19374#ifdef MFC_DEBUG
19375# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19376 block
19377# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19378 use iso_fortran_env, only: output_unit
19379# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19380
19381# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19382 print *, 'm_riemann_solvers.fpp:4668: ', '@:DEALLOCATE(flux_src_rsx_vf)'
19383# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19384
19385# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19386 call flush (output_unit)
19387# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19388 end block
19389# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19390#endif
19391# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19392
19393# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19394#if defined(MFC_OpenACC)
19395# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19396!$acc exit data delete(flux_src_rsx_vf)
19397# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19398#elif defined(MFC_OpenMP)
19399# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19400!$omp target exit data map(release:flux_src_rsx_vf)
19401# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19402#endif
19403# 4668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19404 deallocate (flux_src_rsx_vf)
19405#ifdef MFC_DEBUG
19406# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19407 block
19408# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19409 use iso_fortran_env, only: output_unit
19410# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19411
19412# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19413 print *, 'm_riemann_solvers.fpp:4669: ', '@:DEALLOCATE(flux_gsrc_rsx_vf)'
19414# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19415
19416# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19417 call flush (output_unit)
19418# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19419 end block
19420# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19421#endif
19422# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19423
19424# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19425#if defined(MFC_OpenACC)
19426# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19427!$acc exit data delete(flux_gsrc_rsx_vf)
19428# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19429#elif defined(MFC_OpenMP)
19430# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19431!$omp target exit data map(release:flux_gsrc_rsx_vf)
19432# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19433#endif
19434# 4669 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19435 deallocate (flux_gsrc_rsx_vf)
19436 if (qbmm) then
19437#ifdef MFC_DEBUG
19438# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19439 block
19440# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19441 use iso_fortran_env, only: output_unit
19442# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19443
19444# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19445 print *, 'm_riemann_solvers.fpp:4671: ', '@:DEALLOCATE(mom_sp_rsx_vf)'
19446# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19447
19448# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19449 call flush (output_unit)
19450# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19451 end block
19452# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19453#endif
19454# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19455
19456# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19457#if defined(MFC_OpenACC)
19458# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19459!$acc exit data delete(mom_sp_rsx_vf)
19460# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19461#elif defined(MFC_OpenMP)
19462# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19463!$omp target exit data map(release:mom_sp_rsx_vf)
19464# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19465#endif
19466# 4671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19467 deallocate (mom_sp_rsx_vf)
19468 end if
19469
19470 if (n == 0) return
19471
19472 if (viscous) then
19473#ifdef MFC_DEBUG
19474# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19475 block
19476# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19477 use iso_fortran_env, only: output_unit
19478# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19479
19480# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19481 print *, 'm_riemann_solvers.fpp:4677: ', '@:DEALLOCATE(Re_avg_rsy_vf)'
19482# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19483
19484# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19485 call flush (output_unit)
19486# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19487 end block
19488# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19489#endif
19490# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19491
19492# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19493#if defined(MFC_OpenACC)
19494# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19495!$acc exit data delete(Re_avg_rsy_vf)
19496# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19497#elif defined(MFC_OpenMP)
19498# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19499!$omp target exit data map(release:Re_avg_rsy_vf)
19500# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19501#endif
19502# 4677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19503 deallocate (re_avg_rsy_vf)
19504 end if
19505#ifdef MFC_DEBUG
19506# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19507 block
19508# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19509 use iso_fortran_env, only: output_unit
19510# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19511
19512# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19513 print *, 'm_riemann_solvers.fpp:4679: ', '@:DEALLOCATE(vel_src_rsy_vf)'
19514# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19515
19516# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19517 call flush (output_unit)
19518# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19519 end block
19520# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19521#endif
19522# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19523
19524# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19525#if defined(MFC_OpenACC)
19526# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19527!$acc exit data delete(vel_src_rsy_vf)
19528# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19529#elif defined(MFC_OpenMP)
19530# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19531!$omp target exit data map(release:vel_src_rsy_vf)
19532# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19533#endif
19534# 4679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19535 deallocate (vel_src_rsy_vf)
19536#ifdef MFC_DEBUG
19537# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19538 block
19539# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19540 use iso_fortran_env, only: output_unit
19541# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19542
19543# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19544 print *, 'm_riemann_solvers.fpp:4680: ', '@:DEALLOCATE(flux_rsy_vf)'
19545# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19546
19547# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19548 call flush (output_unit)
19549# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19550 end block
19551# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19552#endif
19553# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19554
19555# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19556#if defined(MFC_OpenACC)
19557# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19558!$acc exit data delete(flux_rsy_vf)
19559# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19560#elif defined(MFC_OpenMP)
19561# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19562!$omp target exit data map(release:flux_rsy_vf)
19563# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19564#endif
19565# 4680 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19566 deallocate (flux_rsy_vf)
19567#ifdef MFC_DEBUG
19568# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19569 block
19570# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19571 use iso_fortran_env, only: output_unit
19572# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19573
19574# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19575 print *, 'm_riemann_solvers.fpp:4681: ', '@:DEALLOCATE(flux_src_rsy_vf)'
19576# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19577
19578# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19579 call flush (output_unit)
19580# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19581 end block
19582# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19583#endif
19584# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19585
19586# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19587#if defined(MFC_OpenACC)
19588# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19589!$acc exit data delete(flux_src_rsy_vf)
19590# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19591#elif defined(MFC_OpenMP)
19592# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19593!$omp target exit data map(release:flux_src_rsy_vf)
19594# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19595#endif
19596# 4681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19597 deallocate (flux_src_rsy_vf)
19598#ifdef MFC_DEBUG
19599# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19600 block
19601# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19602 use iso_fortran_env, only: output_unit
19603# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19604
19605# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19606 print *, 'm_riemann_solvers.fpp:4682: ', '@:DEALLOCATE(flux_gsrc_rsy_vf)'
19607# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19608
19609# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19610 call flush (output_unit)
19611# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19612 end block
19613# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19614#endif
19615# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19616
19617# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19618#if defined(MFC_OpenACC)
19619# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19620!$acc exit data delete(flux_gsrc_rsy_vf)
19621# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19622#elif defined(MFC_OpenMP)
19623# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19624!$omp target exit data map(release:flux_gsrc_rsy_vf)
19625# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19626#endif
19627# 4682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19628 deallocate (flux_gsrc_rsy_vf)
19629 if (qbmm) then
19630#ifdef MFC_DEBUG
19631# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19632 block
19633# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19634 use iso_fortran_env, only: output_unit
19635# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19636
19637# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19638 print *, 'm_riemann_solvers.fpp:4684: ', '@:DEALLOCATE(mom_sp_rsy_vf)'
19639# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19640
19641# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19642 call flush (output_unit)
19643# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19644 end block
19645# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19646#endif
19647# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19648
19649# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19650#if defined(MFC_OpenACC)
19651# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19652!$acc exit data delete(mom_sp_rsy_vf)
19653# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19654#elif defined(MFC_OpenMP)
19655# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19656!$omp target exit data map(release:mom_sp_rsy_vf)
19657# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19658#endif
19659# 4684 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19660 deallocate (mom_sp_rsy_vf)
19661 end if
19662
19663 if (p == 0) return
19664
19665 if (viscous) then
19666#ifdef MFC_DEBUG
19667# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19668 block
19669# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19670 use iso_fortran_env, only: output_unit
19671# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19672
19673# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19674 print *, 'm_riemann_solvers.fpp:4690: ', '@:DEALLOCATE(Re_avg_rsz_vf)'
19675# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19676
19677# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19678 call flush (output_unit)
19679# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19680 end block
19681# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19682#endif
19683# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19684
19685# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19686#if defined(MFC_OpenACC)
19687# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19688!$acc exit data delete(Re_avg_rsz_vf)
19689# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19690#elif defined(MFC_OpenMP)
19691# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19692!$omp target exit data map(release:Re_avg_rsz_vf)
19693# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19694#endif
19695# 4690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19696 deallocate (re_avg_rsz_vf)
19697 end if
19698#ifdef MFC_DEBUG
19699# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19700 block
19701# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19702 use iso_fortran_env, only: output_unit
19703# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19704
19705# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19706 print *, 'm_riemann_solvers.fpp:4692: ', '@:DEALLOCATE(vel_src_rsz_vf)'
19707# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19708
19709# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19710 call flush (output_unit)
19711# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19712 end block
19713# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19714#endif
19715# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19716
19717# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19718#if defined(MFC_OpenACC)
19719# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19720!$acc exit data delete(vel_src_rsz_vf)
19721# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19722#elif defined(MFC_OpenMP)
19723# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19724!$omp target exit data map(release:vel_src_rsz_vf)
19725# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19726#endif
19727# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19728 deallocate (vel_src_rsz_vf)
19729#ifdef MFC_DEBUG
19730# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19731 block
19732# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19733 use iso_fortran_env, only: output_unit
19734# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19735
19736# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19737 print *, 'm_riemann_solvers.fpp:4693: ', '@:DEALLOCATE(flux_rsz_vf)'
19738# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19739
19740# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19741 call flush (output_unit)
19742# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19743 end block
19744# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19745#endif
19746# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19747
19748# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19749#if defined(MFC_OpenACC)
19750# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19751!$acc exit data delete(flux_rsz_vf)
19752# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19753#elif defined(MFC_OpenMP)
19754# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19755!$omp target exit data map(release:flux_rsz_vf)
19756# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19757#endif
19758# 4693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19759 deallocate (flux_rsz_vf)
19760#ifdef MFC_DEBUG
19761# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19762 block
19763# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19764 use iso_fortran_env, only: output_unit
19765# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19766
19767# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19768 print *, 'm_riemann_solvers.fpp:4694: ', '@:DEALLOCATE(flux_src_rsz_vf)'
19769# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19770
19771# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19772 call flush (output_unit)
19773# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19774 end block
19775# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19776#endif
19777# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19778
19779# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19780#if defined(MFC_OpenACC)
19781# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19782!$acc exit data delete(flux_src_rsz_vf)
19783# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19784#elif defined(MFC_OpenMP)
19785# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19786!$omp target exit data map(release:flux_src_rsz_vf)
19787# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19788#endif
19789# 4694 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19790 deallocate (flux_src_rsz_vf)
19791#ifdef MFC_DEBUG
19792# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19793 block
19794# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19795 use iso_fortran_env, only: output_unit
19796# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19797
19798# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19799 print *, 'm_riemann_solvers.fpp:4695: ', '@:DEALLOCATE(flux_gsrc_rsz_vf)'
19800# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19801
19802# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19803 call flush (output_unit)
19804# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19805 end block
19806# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19807#endif
19808# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19809
19810# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19811#if defined(MFC_OpenACC)
19812# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19813!$acc exit data delete(flux_gsrc_rsz_vf)
19814# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19815#elif defined(MFC_OpenMP)
19816# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19817!$omp target exit data map(release:flux_gsrc_rsz_vf)
19818# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19819#endif
19820# 4695 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19821 deallocate (flux_gsrc_rsz_vf)
19822 if (qbmm) then
19823#ifdef MFC_DEBUG
19824# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19825 block
19826# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19827 use iso_fortran_env, only: output_unit
19828# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19829
19830# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19831 print *, 'm_riemann_solvers.fpp:4697: ', '@:DEALLOCATE(mom_sp_rsz_vf)'
19832# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19833
19834# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19835 call flush (output_unit)
19836# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19837 end block
19838# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19839#endif
19840# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19841
19842# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19843#if defined(MFC_OpenACC)
19844# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19845!$acc exit data delete(mom_sp_rsz_vf)
19846# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19847#elif defined(MFC_OpenMP)
19848# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19849!$omp target exit data map(release:mom_sp_rsz_vf)
19850# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19851#endif
19852# 4697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19853 deallocate (mom_sp_rsz_vf)
19854 end if
19855
19856 end subroutine s_finalize_riemann_solvers_module
19857
19858end module m_riemann_solvers
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1067
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1067
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1067
m_bubbles_ee
Computes ensemble-averaged (Euler–Euler) bubble source terms for radius, velocity,...
Definition m_bubbles_EE.fpp.f90:317
m_bubbles_ee::vs
integer, dimension(:), allocatable vs
Definition m_bubbles_EE.fpp.f90:354
m_bubbles_ee::ps
integer, dimension(:), allocatable ps
Definition m_bubbles_EE.fpp.f90:354
m_bubbles_ee::rs
integer, dimension(:), allocatable rs
Definition m_bubbles_EE.fpp.f90:354
m_bubbles
Shared bubble-dynamics procedures (radial acceleration, wall pressure, sound speed) for ensemble- and...
Definition m_bubbles.fpp.f90:318
m_bubbles::f_cpbw_km
elemental real(wp) function f_cpbw_km(fr0, fr, fv, fpb)
Keller-Miksis bubble wall pressure.
Definition m_bubbles.fpp.f90:616
m_chemistry
Multi-species chemistry interface for thermodynamic properties, reaction rates, and transport coeffic...
Definition m_chemistry.fpp.f90:329
m_chemistry::compute_viscosity_and_inversion
subroutine compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l, re_r)
Compute mixture viscosities for left and right states and invert them for use as reciprocal Reynolds ...
Definition m_chemistry.fpp.f90:371
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:317
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:328
m_global_parameters::bubbles_euler
logical bubbles_euler
Bubbles euler on/off.
Definition m_global_parameters.fpp.f90:1050
m_global_parameters::re_size
integer, dimension(2) re_size
Definition m_global_parameters.fpp.f90:849
m_global_parameters::bulk_stress
logical bulk_stress
Bulk stresses.
Definition m_global_parameters.fpp.f90:496
m_global_parameters::grid_geometry
integer grid_geometry
Definition m_global_parameters.fpp.f90:366
m_global_parameters::wave_speeds
integer wave_speeds
Wave speeds estimation method.
Definition m_global_parameters.fpp.f90:482
m_global_parameters::cont_damage
logical cont_damage
Continuum damage modeling.
Definition m_global_parameters.fpp.f90:497
m_global_parameters::hypoelasticity
logical hypoelasticity
hypoelasticity modeling
Definition m_global_parameters.fpp.f90:487
m_global_parameters::avg_state
integer avg_state
Average state evaluation method.
Definition m_global_parameters.fpp.f90:483
m_global_parameters::chemistry
logical, parameter chemistry
Chemistry modeling.
Definition m_global_parameters.fpp.f90:494
m_global_parameters::num_fluids
integer num_fluids
number of fluids in the simulation
Definition m_global_parameters.fpp.f90:451
m_global_parameters::re_idx
integer, dimension(:,:), allocatable re_idx
Definition m_global_parameters.fpp.f90:851
m_global_parameters::weno_re_flux
logical weno_re_flux
WENO reconstruct velocity gradients for viscous stress tensor.
Definition m_global_parameters.fpp.f90:479
m_global_parameters::hyper_cleaning_speed
real(wp) hyper_cleaning_speed
Hyperbolic cleaning wave speed (c_h).
Definition m_global_parameters.fpp.f90:1353
m_global_parameters::dummy
logical dummy
AMDFlang workaround for case-optimization + GPU-kernel bug.
Definition m_global_parameters.fpp.f90:1332
m_global_parameters::sys_size
integer sys_size
Number of unknowns in system of eqns.
Definition m_global_parameters.fpp.f90:799
m_global_parameters::weight
real(wp), dimension(:), allocatable weight
Simpson quadrature weights.
Definition m_global_parameters.fpp.f90:1036
m_global_parameters::cyl_coord
logical cyl_coord
Definition m_global_parameters.fpp.f90:365
m_global_parameters::dir_idx
integer, dimension(3) dir_idx
Definition m_global_parameters.fpp.f90:887
m_global_parameters::viscous
logical viscous
Viscous effects.
Definition m_global_parameters.fpp.f90:463
m_global_parameters::riemann_solver
integer riemann_solver
Riemann solver algorithm.
Definition m_global_parameters.fpp.f90:480
m_global_parameters::model_eqns
integer model_eqns
Multicomponent flow model.
Definition m_global_parameters.fpp.f90:434
m_global_parameters::hyperelasticity
logical hyperelasticity
hyperelasticity modeling
Definition m_global_parameters.fpp.f90:488
m_global_parameters::fluid_pp
type(physical_parameters), dimension(num_fluids_max) fluid_pp
Stiffened gas EOS parameters and Reynolds numbers per fluid.
Definition m_global_parameters.fpp.f90:937
m_global_parameters::dir_idx_tau
integer, dimension(3) dir_idx_tau
used for hypoelasticity=true
Definition m_global_parameters.fpp.f90:889
m_global_parameters::num_dims
integer num_dims
Number of spatial dimensions.
Definition m_global_parameters.fpp.f90:436
m_global_parameters::r0
real(wp), dimension(:), allocatable r0
Bubble sizes.
Definition m_global_parameters.fpp.f90:1037
m_global_parameters::chem_params
type(chemistry_parameters) chem_params
Definition m_global_parameters.fpp.f90:1155
m_global_parameters::num_vels
integer num_vels
Number of velocity components (different from num_dims for mhd).
Definition m_global_parameters.fpp.f90:437
m_global_parameters::polytropic
logical polytropic
Polytropic switch.
Definition m_global_parameters.fpp.f90:1051
m_global_parameters::qbmm
logical qbmm
Quadrature moment method.
Definition m_global_parameters.fpp.f90:1109
m_global_parameters::hyper_cleaning
logical hyper_cleaning
Hyperbolic cleaning for MHD for divB=0.
Definition m_global_parameters.fpp.f90:498
m_global_parameters::bx0
real(wp) bx0
Constant magnetic field in the x-direction (1D).
Definition m_global_parameters.fpp.f90:1318
m_global_parameters::b_size
integer b_size
Number of elements in the symmetric b tensor, plus one.
Definition m_global_parameters.fpp.f90:802
m_global_parameters::qvs
real(wp), dimension(:), allocatable qvs
Definition m_global_parameters.fpp.f90:1270
m_global_parameters::pi_infs
real(wp), dimension(:), allocatable pi_infs
Definition m_global_parameters.fpp.f90:1270
m_global_parameters::adv_n
logical adv_n
Solve the number density equation and compute alpha from number density.
Definition m_global_parameters.fpp.f90:1065
m_global_parameters::dir_flg
real(wp), dimension(3) dir_flg
Definition m_global_parameters.fpp.f90:888
m_global_parameters::mhd
logical mhd
Magnetohydrodynamics.
Definition m_global_parameters.fpp.f90:457
m_global_parameters::shear_indices
integer, dimension(3) shear_indices
Indices of the stress components that represent shear stress.
Definition m_global_parameters.fpp.f90:918
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:352
m_global_parameters::surface_tension
logical surface_tension
Definition m_global_parameters.fpp.f90:1256
m_global_parameters::elasticity
logical elasticity
elasticity modeling, true for hyper or hypo
Definition m_global_parameters.fpp.f90:493
m_global_parameters::nb
integer nb
Number of eq. bubble sizes.
Definition m_global_parameters.fpp.f90:1017
m_global_parameters::mpp_lim
logical mpp_lim
Mixture physical parameters (MPP) limits.
Definition m_global_parameters.fpp.f90:439
m_global_parameters::low_mach
integer low_mach
Low Mach number fix to HLLC Riemann solver.
Definition m_global_parameters.fpp.f90:481
m_global_parameters::shear_stress
logical shear_stress
Shear stresses.
Definition m_global_parameters.fpp.f90:495
m_global_parameters::relativity
logical relativity
Relativity (only for MHD).
Definition m_global_parameters.fpp.f90:458
m_global_parameters::gammas
real(wp), dimension(:), allocatable gammas
Definition m_global_parameters.fpp.f90:1270
m_global_parameters::eqn_idx
type(eqn_idx_info) eqn_idx
All conserved-variable equation index ranges and scalars.
Definition m_global_parameters.fpp.f90:800
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:317
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:328
m_riemann_solvers
Approximate and exact Riemann solvers (HLL, HLLC, HLLD, exact) for the multicomponent Navier–Stokes e...
Definition m_riemann_solvers.fpp.f90:338
m_riemann_solvers::s_hlld_riemann_solver
subroutine, public s_hlld_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
HLLD Riemann solver for MHD, Miyoshi & Kusano JCP (2005).
Definition m_riemann_solvers.fpp.f90:15328
m_riemann_solvers::is2
type(int_bounds_info) is2
Definition m_riemann_solvers.fpp.f90:447
m_riemann_solvers::re_avg_rsx_vf
real(wp), dimension(:,:,:,:), allocatable re_avg_rsx_vf
Definition m_riemann_solvers.fpp.f90:430
m_riemann_solvers::flux_gsrc_rsy_vf
real(wp), dimension(:,:,:,:), allocatable flux_gsrc_rsy_vf
Definition m_riemann_solvers.fpp.f90:383
m_riemann_solvers::vel_src_rsz_vf
real(wp), dimension(:,:,:,:), allocatable vel_src_rsz_vf
Definition m_riemann_solvers.fpp.f90:402
m_riemann_solvers::flux_rsy_vf
real(wp), dimension(:,:,:,:), allocatable flux_rsy_vf
Definition m_riemann_solvers.fpp.f90:364
m_riemann_solvers::s_hll_riemann_solver
subroutine, public s_hll_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
HLL approximate Riemann solver, Harten et al. SIAM Review (1983).
Definition m_riemann_solvers.fpp.f90:570
m_riemann_solvers::mom_sp_rsy_vf
real(wp), dimension(:,:,:,:), allocatable mom_sp_rsy_vf
Definition m_riemann_solvers.fpp.f90:416
m_riemann_solvers::s_compute_cylindrical_viscous_source_flux
subroutine s_compute_cylindrical_viscous_source_flux(vell_vf, dvell_dx_vf, dvell_dy_vf, dvell_dz_vf, velr_vf, dvelr_dx_vf, dvelr_dy_vf, dvelr_dz_vf, flux_src_vf, norm_dir, ix, iy, iz)
Compute cylindrical viscous source flux contributions for momentum and energy.
Definition m_riemann_solvers.fpp.f90:18359
m_riemann_solvers::s_compute_cartesian_viscous_source_flux
subroutine s_compute_cartesian_viscous_source_flux(dvell_dx_vf, dvell_dy_vf, dvell_dz_vf, dvelr_dx_vf, dvelr_dy_vf, dvelr_dz_vf, flux_src_vf, norm_dir)
Compute Cartesian viscous source flux contributions for momentum and energy.
Definition m_riemann_solvers.fpp.f90:18572
m_riemann_solvers::s_calculate_bulk_stress_tensor
subroutine s_calculate_bulk_stress_tensor(re_bulk, divergence_v, tau_bulk_out)
Compute bulk stress tensor components (diagonal only).
Definition m_riemann_solvers.fpp.f90:18764
m_riemann_solvers::res_gs
real(wp), dimension(:,:), allocatable res_gs
Definition m_riemann_solvers.fpp.f90:476
m_riemann_solvers::vel_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable vel_src_rsx_vf
Definition m_riemann_solvers.fpp.f90:400
m_riemann_solvers::is1
type(int_bounds_info) is1
Definition m_riemann_solvers.fpp.f90:447
m_riemann_solvers::s_populate_riemann_states_variables_buffers
subroutine s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
Populate the left and right Riemann state variable buffers based on boundary conditions.
Definition m_riemann_solvers.fpp.f90:16857
m_riemann_solvers::s_finalize_riemann_solver
subroutine s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
Deallocation and/or disassociation procedures that are needed to finalize the selected Riemann proble...
Definition m_riemann_solvers.fpp.f90:18800
m_riemann_solvers::isx
type(int_bounds_info) isx
Definition m_riemann_solvers.fpp.f90:448
m_riemann_solvers::s_finalize_riemann_solvers_module
impure subroutine, public s_finalize_riemann_solvers_module
Module deallocation and/or disassociation procedures.
Definition m_riemann_solvers.fpp.f90:19278
m_riemann_solvers::s_hllc_riemann_solver
subroutine, public s_hllc_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994).
Definition m_riemann_solvers.fpp.f90:6461
m_riemann_solvers::s_calculate_shear_stress_tensor
subroutine s_calculate_shear_stress_tensor(vel_grad_avg, re_shear, divergence_v, tau_shear_out)
Compute shear stress tensor components.
Definition m_riemann_solvers.fpp.f90:18721
m_riemann_solvers::vel_src_rsy_vf
real(wp), dimension(:,:,:,:), allocatable vel_src_rsy_vf
Definition m_riemann_solvers.fpp.f90:401
m_riemann_solvers::is3
type(int_bounds_info) is3
Definition m_riemann_solvers.fpp.f90:447
m_riemann_solvers::mom_sp_rsz_vf
real(wp), dimension(:,:,:,:), allocatable mom_sp_rsz_vf
Definition m_riemann_solvers.fpp.f90:417
m_riemann_solvers::flux_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_src_rsx_vf
Definition m_riemann_solvers.fpp.f90:363
m_riemann_solvers::flux_gsrc_rsz_vf
real(wp), dimension(:,:,:,:), allocatable flux_gsrc_rsz_vf
Definition m_riemann_solvers.fpp.f90:384
m_riemann_solvers::s_lf_riemann_solver
subroutine, public s_lf_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
Lax-Friedrichs (Rusanov) approximate Riemann solver.
Definition m_riemann_solvers.fpp.f90:3660
m_riemann_solvers::s_initialize_riemann_solver
subroutine s_initialize_riemann_solver(flux_src_vf, norm_dir)
Set up the chosen Riemann solver algorithm for the current direction.
Definition m_riemann_solvers.fpp.f90:17938
m_riemann_solvers::flux_src_rsy_vf
real(wp), dimension(:,:,:,:), allocatable flux_src_rsy_vf
Definition m_riemann_solvers.fpp.f90:364
m_riemann_solvers::flux_rsz_vf
real(wp), dimension(:,:,:,:), allocatable flux_rsz_vf
Definition m_riemann_solvers.fpp.f90:365
m_riemann_solvers::mom_sp_rsx_vf
real(wp), dimension(:,:,:,:), allocatable mom_sp_rsx_vf
Definition m_riemann_solvers.fpp.f90:415
m_riemann_solvers::re_avg_rsy_vf
real(wp), dimension(:,:,:,:), allocatable re_avg_rsy_vf
Definition m_riemann_solvers.fpp.f90:431
m_riemann_solvers::flux_gsrc_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_gsrc_rsx_vf
The cell-boundary values of the geometrical source flux that are computed through the chosen Riemann ...
Definition m_riemann_solvers.fpp.f90:382
m_riemann_solvers::flux_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_rsx_vf
The cell-boundary values of the fluxes (src - source) that are computed through the chosen Riemann pr...
Definition m_riemann_solvers.fpp.f90:363
m_riemann_solvers::isy
type(int_bounds_info) isy
Definition m_riemann_solvers.fpp.f90:448
m_riemann_solvers::s_initialize_riemann_solvers_module
impure subroutine, public s_initialize_riemann_solvers_module
Initialize the Riemann solvers module.
Definition m_riemann_solvers.fpp.f90:16102
m_riemann_solvers::isz
type(int_bounds_info) isz
Definition m_riemann_solvers.fpp.f90:448
m_riemann_solvers::gs_rs
real(wp), dimension(:), allocatable gs_rs
Definition m_riemann_solvers.fpp.f90:463
m_riemann_solvers::re_avg_rsz_vf
real(wp), dimension(:,:,:,:), allocatable re_avg_rsz_vf
Definition m_riemann_solvers.fpp.f90:432
m_riemann_solvers::s_compute_viscous_source_flux
subroutine s_compute_viscous_source_flux(vell_vf, dvell_dx_vf, dvell_dy_vf, dvell_dz_vf, velr_vf, dvelr_dx_vf, dvelr_dy_vf, dvelr_dz_vf, flux_src_vf, norm_dir, ix, iy, iz)
Dispatch to the subroutines that are utilized to compute the viscous source fluxes for either Cartesi...
Definition m_riemann_solvers.fpp.f90:547
m_riemann_solvers::flux_src_rsz_vf
real(wp), dimension(:,:,:,:), allocatable flux_src_rsz_vf
Definition m_riemann_solvers.fpp.f90:365
m_riemann_solvers::s_riemann_solver
subroutine, public s_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
Dispatch to the subroutines that are utilized to compute the Riemann problem solution....
Definition m_riemann_solvers.fpp.f90:497
m_surface_tension
Computes capillary source fluxes and color-function gradients for the diffuse-interface surface tensi...
Definition m_surface_tension.fpp.f90:331
m_surface_tension::s_compute_capillary_source_flux
subroutine, public s_compute_capillary_source_flux(vsrc_rsx_vf, vsrc_rsy_vf, vsrc_rsz_vf, flux_src_vf, id, isx, isy, isz)
Compute the capillary source flux from reconstructed color-gradient fields.
Definition m_surface_tension.fpp.f90:733
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:328
m_variables_conversion::s_compute_fast_magnetosonic_speed
subroutine s_compute_fast_magnetosonic_speed(rho, c, b, norm, c_fast, h)
Compute the fast magnetosonic wave speed from the sound speed, density, and magnetic field components...
Definition m_variables_conversion.fpp.f90:2640
m_variables_conversion::s_compute_speed_of_sound
subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, h, adv, vel_sum, c_c, c, qv)
Compute the speed of sound from thermodynamic state variables, supporting multiple equation-of-state ...
Definition m_variables_conversion.fpp.f90:2556
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:411
m_derived_types::riemann_states_vec3
Left and right Riemann states for 3-component vectors.
Definition m_derived_types.fpp.f90:399
m_derived_types::riemann_states
Left and right Riemann states.
Definition m_derived_types.fpp.f90:393
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:331