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, contxe
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, contxe + i)
696 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + 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, e_idx + i)
714 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
715 end do
716
717 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
718 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
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, b_idx%beg)
725 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg)
726 b%L(3) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)
727 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 1)
728 else ! 2D/3D: Bx, By, Bz as variables
729 b%L(1) = ql_prim_rsx_vf(j, k, l, b_idx%beg)
730 b%R(1) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg)
731 b%L(2) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)
732 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 1)
733 b%L(3) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 2)
734 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, b_idx%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 = chemxb, chemxe
855 ys_l(i - chemxb + 1) = ql_prim_rsx_vf(j, k, l, i)
856 ys_r(i - chemxb + 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, damage_idx)), 0._wp)
967 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, damage_idx)), 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, strxe - strxb + 1
982 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
983 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 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(strxb - 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, contxe
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, contxe
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 & contxe + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i)*b%R(norm_dir) &
1336 & + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
1337 & - 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 & contxe + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i)/ga%R*b%R(norm_dir) &
1357 & + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i)*vel_l(norm_dir) &
1358 & - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
1359 & + 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 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1376 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
1377 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
1378 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
1379 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
1380 end do
1381 else if (hypoelasticity) then
1382
1383# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1384#if defined(MFC_OpenACC)
1385# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1386!$acc loop seq
1387# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1388#elif defined(MFC_OpenMP)
1389# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1390
1391# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1392#endif
1393 do i = 1, num_vels
1394 flux_rsx_vf(j, k, l, &
1395 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1396 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
1397 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
1398 & *pres_l - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
1399 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
1400 end do
1401 else
1402
1403# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1404#if defined(MFC_OpenACC)
1405# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1406!$acc loop seq
1407# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1408#elif defined(MFC_OpenMP)
1409# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1410
1411# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1412#endif
1413 do i = 1, num_vels
1414 flux_rsx_vf(j, k, l, &
1415 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1416 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1)) &
1417 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l) &
1418 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
1419 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
1420 end do
1421 end if
1422
1423 ! Energy
1424 if (mhd .and. (.not. relativity)) then
1425 ! energy flux = (E + p + p_mag) * v_x - B_x * (v_x*B_x + v_y*B_y + v_z*B_z)
1426# 644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1427 flux_rsx_vf(j, k, l, &
1428 & e_idx) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
1429 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
1430 & - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir) &
1431 & *(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) + s_m*s_p*(e_l &
1432 & - e_r))/(s_m - s_p)
1433# 651 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1434 else if (mhd .and. relativity) then
1435 ! energy flux = m_x - mass flux Hard-coded for single-component for now
1436 flux_rsx_vf(j, k, l, &
1437 & e_idx) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
1438 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l &
1439 & - e_r))/(s_m - s_p)
1440 else if (bubbles_euler) then
1441 flux_rsx_vf(j, k, l, &
1442 & e_idx) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
1443 & - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m &
1444 & - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
1445 else if (hypoelasticity) then
1446 flux_tau_l = 0._wp; flux_tau_r = 0._wp
1447
1448# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1449#if defined(MFC_OpenACC)
1450# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1451!$acc loop seq
1452# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1453#elif defined(MFC_OpenMP)
1454# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1455
1456# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1457#endif
1458 do i = 1, num_dims
1459 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
1460 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
1461 end do
1462 flux_rsx_vf(j, k, l, &
1463 & e_idx) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
1464 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r)) &
1465 & /(s_m - s_p)
1466 else
1467 flux_rsx_vf(j, k, l, &
1468 & e_idx) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
1469 & + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
1470 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
1471 end if
1472
1473 ! Elastic Stresses
1474 if (hypoelasticity) then
1475 do i = 1, strxe - strxb + 1 ! TODO: this indexing may be slow
1476 flux_rsx_vf(j, k, l, &
1477 & strxb - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
1478 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
1479 & - rho_r*tau_e_r(i)))/(s_m - s_p)
1480 end do
1481 end if
1482
1483 ! Advection flux and source: interface velocity for volume fraction transport
1484
1485# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1486#if defined(MFC_OpenACC)
1487# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1488!$acc loop seq
1489# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1490#elif defined(MFC_OpenMP)
1491# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1492
1493# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1494#endif
1495 do i = advxb, advxe
1496 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j + 1, &
1497 & k, l, i))*s_m*s_p/(s_m - s_p)
1498 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j + 1, k, l, &
1499 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
1500 end do
1501
1502 if (bubbles_euler) then
1503 ! From HLLC: Kills mass transport @ bubble gas density
1504 if (num_fluids > 1) then
1505 flux_rsx_vf(j, k, l, contxe) = 0._wp
1506 end if
1507 end if
1508
1509 if (chemistry) then
1510
1511# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1512#if defined(MFC_OpenACC)
1513# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1514!$acc loop seq
1515# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1516#elif defined(MFC_OpenMP)
1517# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1518
1519# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1520#endif
1521 do i = chemxb, chemxe
1522 y_l = ql_prim_rsx_vf(j, k, l, i)
1523 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
1524
1525 flux_rsx_vf(j, k, l, &
1526 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
1527 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
1528 flux_src_rsx_vf(j, k, l, i) = 0._wp
1529 end do
1530 end if
1531
1532 ! MHD: magnetic flux and Maxwell stress contributions
1533 if (mhd) then
1534 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
1535 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
1536
1537# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1538#if defined(MFC_OpenACC)
1539# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1540!$acc loop seq
1541# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1542#elif defined(MFC_OpenMP)
1543# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1544
1545# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1546#endif
1547 do i = 0, 1
1548 flux_rsx_vf(j, k, l, &
1549 & b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
1550 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
1551 & - b%R(2 + i)))/(s_m - s_p)
1552 end do
1553 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
1554 ! B_x d/dx flux = (1 - delta(x,x)) * (v_x * B_x - v_x * B_x) B_y
1555 ! d/dx flux = (1 - delta(y,x)) * (v_x * B_y - v_y * B_x) B_z d/dx
1556 ! flux = (1 - delta(z,x)) * (v_x * B_z - v_z * B_x)
1557
1558# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1559#if defined(MFC_OpenACC)
1560# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1561!$acc loop seq
1562# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1563#elif defined(MFC_OpenMP)
1564# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1565
1566# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1567#endif
1568 do i = 0, 2
1569 flux_rsx_vf(j, k, l, &
1570 & b_idx%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1) &
1571 & *b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1) &
1572 & *b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
1573 end do
1574
1575 if (hyper_cleaning) then
1576 ! propagate magnetic field divergence as a wave
1577 flux_rsx_vf(j, k, l, b_idx%beg + norm_dir - 1) = flux_rsx_vf(j, k, l, &
1578 & b_idx%beg + norm_dir - 1) + (s_m*qr_prim_rsx_vf(j + 1, k, l, &
1579 & psi_idx) - s_p*ql_prim_rsx_vf(j, k, l, psi_idx))/(s_m - s_p)
1580
1581 flux_rsx_vf(j, k, l, &
1582 & psi_idx) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) &
1583 & - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsx_vf(j, k, l, &
1584 & psi_idx) - qr_prim_rsx_vf(j + 1, k, l, psi_idx)))/(s_m - s_p)
1585 else
1586 flux_rsx_vf(j, k, l, &
1587 & b_idx%beg + norm_dir - 1) &
1588 & = 0._wp ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
1589 end if
1590 end if
1591 flux_src_rsx_vf(j, k, l, advxb) = 0._wp
1592 end if
1593
1594# 789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1595 end do
1596 end do
1597 end do
1598
1599# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1600#if defined(MFC_OpenACC)
1601# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1602!$acc end parallel loop
1603# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1604#elif defined(MFC_OpenMP)
1605# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1606
1607# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1608!$omp end target teams loop
1609# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1610#endif
1611 end if
1612# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1613 if (norm_dir == 2) then
1614
1615# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1616
1617# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1618#if defined(MFC_OpenACC)
1619# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1620!$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)
1621# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1622#elif defined(MFC_OpenMP)
1623# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1624
1625# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1626
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!$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)
1631# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1632#endif
1633# 232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1634 do l = is3%beg, is3%end
1635 do k = is2%beg, is2%end
1636 do j = is1%beg, is1%end
1637
1638# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1639#if defined(MFC_OpenACC)
1640# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1641!$acc loop seq
1642# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1643#elif defined(MFC_OpenMP)
1644# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1645
1646# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1647#endif
1648 do i = 1, contxe
1649 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
1650 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
1651 end do
1652
1653 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1654
1655
1656# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1657#if defined(MFC_OpenACC)
1658# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1659!$acc loop seq
1660# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1661#elif defined(MFC_OpenMP)
1662# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1663
1664# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1665#endif
1666 do i = 1, num_vels
1667 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
1668 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
1669 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1670 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1671 end do
1672
1673
1674# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1675#if defined(MFC_OpenACC)
1676# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1677!$acc loop seq
1678# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1679#elif defined(MFC_OpenMP)
1680# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1681
1682# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1683#endif
1684 do i = 1, num_fluids
1685 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
1686 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
1687 end do
1688
1689 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
1690 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
1691
1692 if (mhd) then
1693 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
1694 b%L(1) = bx0
1695 b%R(1) = bx0
1696 b%L(2) = ql_prim_rsy_vf(j, k, l, b_idx%beg)
1697 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg)
1698 b%L(3) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)
1699 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 1)
1700 else ! 2D/3D: Bx, By, Bz as variables
1701 b%L(1) = ql_prim_rsy_vf(j, k, l, b_idx%beg)
1702 b%R(1) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg)
1703 b%L(2) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)
1704 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 1)
1705 b%L(3) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 2)
1706 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 2)
1707 end if
1708 end if
1709
1710 rho_l = 0._wp
1711 gamma_l = 0._wp
1712 pi_inf_l = 0._wp
1713 qv_l = 0._wp
1714
1715 rho_r = 0._wp
1716 gamma_r = 0._wp
1717 pi_inf_r = 0._wp
1718 qv_r = 0._wp
1719
1720 alpha_l_sum = 0._wp
1721 alpha_r_sum = 0._wp
1722
1723 pres_mag%L = 0._wp
1724 pres_mag%R = 0._wp
1725
1726 if (mpp_lim) then
1727
1728# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1729#if defined(MFC_OpenACC)
1730# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1731!$acc loop seq
1732# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1733#elif defined(MFC_OpenMP)
1734# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1735
1736# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1737#endif
1738 do i = 1, num_fluids
1739 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
1740 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
1741 alpha_l_sum = alpha_l_sum + alpha_l(i)
1742 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
1743 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
1744 alpha_r_sum = alpha_r_sum + alpha_r(i)
1745 end do
1746
1747 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
1748 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
1749 end if
1750
1751
1752# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1753#if defined(MFC_OpenACC)
1754# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1755!$acc loop seq
1756# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1757#elif defined(MFC_OpenMP)
1758# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1759
1760# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1761#endif
1762 do i = 1, num_fluids
1763 rho_l = rho_l + alpha_rho_l(i)
1764 gamma_l = gamma_l + alpha_l(i)*gammas(i)
1765 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
1766 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
1767
1768 rho_r = rho_r + alpha_rho_r(i)
1769 gamma_r = gamma_r + alpha_r(i)*gammas(i)
1770 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
1771 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
1772 end do
1773
1774 if (viscous) then
1775
1776# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1777#if defined(MFC_OpenACC)
1778# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1779!$acc loop seq
1780# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1781#elif defined(MFC_OpenMP)
1782# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1783
1784# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1785#endif
1786 do i = 1, 2
1787 re_l(i) = dflt_real
1788 re_r(i) = dflt_real
1789
1790 if (re_size(i) > 0) re_l(i) = 0._wp
1791 if (re_size(i) > 0) re_r(i) = 0._wp
1792
1793
1794# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1795#if defined(MFC_OpenACC)
1796# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1797!$acc loop seq
1798# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1799#elif defined(MFC_OpenMP)
1800# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1801
1802# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1803#endif
1804 do q = 1, re_size(i)
1805 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
1806 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
1807 end do
1808
1809 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
1810 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
1811 end do
1812 end if
1813
1814 if (chemistry) then
1815
1816# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1817#if defined(MFC_OpenACC)
1818# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1819!$acc loop seq
1820# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1821#elif defined(MFC_OpenMP)
1822# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1823
1824# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1825#endif
1826 do i = chemxb, chemxe
1827 ys_l(i - chemxb + 1) = ql_prim_rsy_vf(j, k, l, i)
1828 ys_r(i - chemxb + 1) = qr_prim_rsy_vf(j + 1, k, l, i)
1829 end do
1830
1831 call get_mixture_molecular_weight(ys_l, mw_l)
1832 call get_mixture_molecular_weight(ys_r, mw_r)
1833# 355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1834 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
1835 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
1836# 358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1837
1838 r_gas_l = gas_constant/mw_l
1839 r_gas_r = gas_constant/mw_r
1840 t_l = pres_l/rho_l/r_gas_l
1841 t_r = pres_r/rho_r/r_gas_r
1842
1843 call get_species_specific_heats_r(t_l, cp_il)
1844 call get_species_specific_heats_r(t_r, cp_ir)
1845
1846 if (chem_params%gamma_method == 1) then
1847 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
1848 gamma_il = cp_il/(cp_il - 1.0_wp)
1849 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
1850
1851 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
1852 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
1853 else if (chem_params%gamma_method == 2) then
1854 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
1855 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
1856 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
1857 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
1858 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
1859
1860 gamm_l = cp_l/cv_l
1861 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
1862 gamm_r = cp_r/cv_r
1863 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
1864 end if
1865
1866 call get_mixture_energy_mass(t_l, ys_l, e_l)
1867 call get_mixture_energy_mass(t_r, ys_r, e_r)
1868
1869 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
1870 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
1871 h_l = (e_l + pres_l)/rho_l
1872 h_r = (e_r + pres_r)/rho_r
1873 else if (mhd .and. relativity) then
1874 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
1875 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
1876# 398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1877 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
1878 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
1879
1880 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
1881 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
1882 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
1883 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
1884# 406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1885
1886 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
1887 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
1888
1889 ! Hard-coded EOS
1890 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
1891 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
1892# 414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1893 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
1894 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
1895# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1896
1897 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
1898 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
1899 else if (mhd .and. .not. relativity) then
1900# 422 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1901 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
1902 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
1903# 425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1904 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
1905 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r &
1906 & + pres_mag%R ! includes magnetic energy
1907 h_l = (e_l + pres_l - pres_mag%L)/rho_l
1908 h_r = (e_r + pres_r - pres_mag%R) &
1909 & /rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
1910 else
1911 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
1912 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
1913 h_l = (e_l + pres_l)/rho_l
1914 h_r = (e_r + pres_r)/rho_r
1915 end if
1916
1917 ! elastic energy update
1918 if (hypoelasticity) then
1919 g_l = 0._wp; g_r = 0._wp
1920
1921
1922# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1923#if defined(MFC_OpenACC)
1924# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1925!$acc loop seq
1926# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1927#elif defined(MFC_OpenMP)
1928# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1929
1930# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1931#endif
1932 do i = 1, num_fluids
1933 g_l = g_l + alpha_l(i)*gs_rs(i)
1934 g_r = g_r + alpha_r(i)*gs_rs(i)
1935 end do
1936
1937 if (cont_damage) then
1938 g_l = g_l*max((1._wp - ql_prim_rsy_vf(j, k, l, damage_idx)), 0._wp)
1939 g_r = g_r*max((1._wp - qr_prim_rsy_vf(j, k, l, damage_idx)), 0._wp)
1940 end if
1941
1942
1943# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1944#if defined(MFC_OpenACC)
1945# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1946!$acc loop seq
1947# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1948#elif defined(MFC_OpenMP)
1949# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1950
1951# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1952#endif
1953 do i = 1, strxe - strxb + 1
1954 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
1955 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
1956 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
1957 if ((g_l > 1000) .and. (g_r > 1000)) then
1958 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
1959 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
1960 ! Double for shear stresses
1961 if (any(strxb - 1 + i == shear_indices)) 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 end if
1965 end if
1966 end do
1967 end if
1968
1969 if (avg_state == 1) then
1970# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1971 rho_avg = sqrt(rho_l*rho_r)
1972# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1973
1974# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1975 vel_avg_rms = 0._wp
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
1980# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1981#if defined(MFC_OpenACC)
1982# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1983!$acc loop seq
1984# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1985#elif defined(MFC_OpenMP)
1986# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1987
1988# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1989#endif
1990# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1991 do i = 1, num_vels
1992# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1993 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
1994# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1995 end do
1996# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1997
1998# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1999 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
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 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_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 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
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 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
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 if (chemistry) then
2016# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2017 eps = 0.001_wp
2018# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2019 call get_species_enthalpies_rt(t_l, h_il)
2020# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2021 call get_species_enthalpies_rt(t_r, h_ir)
2022# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2023 h_il = h_il*gas_constant/molecular_weights*t_l
2024# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2025 h_ir = h_ir*gas_constant/molecular_weights*t_r
2026# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2027 call get_species_specific_heats_r(t_l, cp_il)
2028# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2029 call get_species_specific_heats_r(t_r, cp_ir)
2030# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2031
2032# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2033 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
2034# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2035 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
2036# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2037 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
2038# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2039 if (abs(t_l - t_r) < eps) then
2040# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2041 ! Case when T_L and T_R are very close
2042# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2043 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
2044# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2045 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
2046# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2047 & - gas_constant/molecular_weights(:)))
2048# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2049 else
2050# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2051 ! Normal calculation when T_L and T_R are sufficiently different
2052# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2053 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
2054# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2055 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
2056# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2057 end if
2058# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2059 gamma_avg = cp_avg/cv_avg
2060# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2061
2062# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2063 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
2064# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2065 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
2066# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2067 end if
2068# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2069 end if
2070# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2071
2072# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2073 if (avg_state == 2) then
2074# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2075 rho_avg = 5.e-1_wp*(rho_l + rho_r)
2076# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2077 vel_avg_rms = 0._wp
2078# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2079
2080# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2081#if defined(MFC_OpenACC)
2082# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2083!$acc loop seq
2084# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2085#elif defined(MFC_OpenMP)
2086# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2087
2088# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2089#endif
2090# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2091 do i = 1, num_vels
2092# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2093 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
2094# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2095 end do
2096# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2097
2098# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2099 h_avg = 5.e-1_wp*(h_l + h_r)
2100# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2101 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
2102# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2103 qv_avg = 5.e-1_wp*(qv_l + qv_r)
2104# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2105 end if
2106
2107 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, &
2108 & qv_l)
2109
2110 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, &
2111 & qv_r)
2112
2113 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
2114 ! variables are placeholders to call the subroutine.
2115
2116 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
2117 & c_sum_yi_phi, c_avg, qv_avg)
2118
2119 if (mhd) then
2120 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
2121 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
2122 end if
2123
2124 if (viscous) then
2125 if (chemistry) then
2126 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
2127 end if
2128
2129# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2130#if defined(MFC_OpenACC)
2131# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2132!$acc loop seq
2133# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2134#elif defined(MFC_OpenMP)
2135# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2136
2137# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2138#endif
2139 do i = 1, 2
2140 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2141 end do
2142 end if
2143
2144 ! Wave speed estimates (wave_speeds=1: direct, wave_speeds=2: pressure-based)
2145 if (wave_speeds == 1) then
2146 if (mhd) then
2147 ! MHD: use fast magnetosonic speed
2148 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
2149 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
2150 else if (hypoelasticity) then
2151 ! Elastic wave speed, Rodriguez et al. JCP (2019)
2152 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))) &
2153 & /rho_l), &
2154 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
2155 & /rho_r))
2156 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))) &
2157 & /rho_r), &
2158 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
2159 & /rho_l))
2160 else if (hyperelasticity) then
2161 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l), &
2162 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
2163 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r), &
2164 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
2165 else
2166 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
2167 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
2168 end if
2169
2170 if (hyper_cleaning) then
2171 ! Dedner GLM divergence cleaning, Dedner et al. JCP (2002)
2172 s_l = min(s_l, -hyper_cleaning_speed)
2173 s_r = max(s_r, hyper_cleaning_speed)
2174 end if
2175
2176 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
2177 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
2178 & - rho_r*(s_r - vel_r(dir_idx(1))))
2179 else if (wave_speeds == 2) then
2180 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2181
2182 pres_sr = pres_sl
2183
2184 ! Low Mach correction: Thornber et al. JCP (2008)
2185 ms_l = max(1._wp, &
2186 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
2187 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
2188 ms_r = max(1._wp, &
2189 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
2190 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
2191
2192 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2193 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2194
2195 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
2196 end if
2197
2198 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2199
2200 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, &
2201 & s_r))
2202 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, &
2203 & s_r))
2204
2205 ! 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
2206 if (low_mach == 1) then
2207 if (riemann_solver == 1 .or. riemann_solver == 5) then
2208# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2209 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2210# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2211 pcorr = 0._wp
2212# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2213
2214# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2215 if (low_mach == 1) then
2216# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2217 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2218# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2219 end if
2220# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2221 else if (riemann_solver == 2) then
2222# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2223 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2224# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2225 pcorr = 0._wp
2226# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2227
2228# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2229 if (low_mach == 1) then
2230# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2231 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))) &
2232# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2233 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2234# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2235 else if (low_mach == 2) then
2236# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2237 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))))
2238# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2239 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))))
2240# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2241 vel_l(dir_idx(1)) = vel_l_tmp
2242# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2243 vel_r(dir_idx(1)) = vel_r_tmp
2244# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2245 end if
2246# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2247 end if
2248 else
2249 pcorr = 0._wp
2250 end if
2251
2252 ! Mass
2253 if (.not. relativity) then
2254
2255# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2256#if defined(MFC_OpenACC)
2257# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2258!$acc loop seq
2259# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2260#elif defined(MFC_OpenMP)
2261# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2262
2263# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2264#endif
2265 do i = 1, contxe
2266 flux_rsy_vf(j, k, l, &
2267 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i) &
2268 & *vel_l(norm_dir) + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
2269 end do
2270 else if (relativity) then
2271
2272# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2273#if defined(MFC_OpenACC)
2274# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2275!$acc loop seq
2276# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2277#elif defined(MFC_OpenMP)
2278# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2279
2280# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2281#endif
2282 do i = 1, contxe
2283 flux_rsy_vf(j, k, l, &
2284 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
2285 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i))) &
2286 & /(s_m - s_p)
2287 end do
2288 end if
2289
2290 ! Momentum
2291 if (mhd .and. (.not. relativity)) then
2292
2293# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2294#if defined(MFC_OpenACC)
2295# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2296!$acc loop seq
2297# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2298#elif defined(MFC_OpenMP)
2299# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2300
2301# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2302#endif
2303 do i = 1, 3
2304 ! Flux of rho*v_i in the y direction = rho * v_i * v_y - B_i * B_y +
2305 ! delta_(y,i) * p_tot
2306 flux_rsy_vf(j, k, l, &
2307 & contxe + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i)*b%R(norm_dir) &
2308 & + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
2309 & - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
2310 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
2311 end do
2312 else if (mhd .and. relativity) then
2313
2314# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2315#if defined(MFC_OpenACC)
2316# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2317!$acc loop seq
2318# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2319#elif defined(MFC_OpenMP)
2320# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2321
2322# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2323#endif
2324 do i = 1, 3
2325 ! Flux of m_i in the y direction = m_i * v_y - b_i/Gamma * B_y +
2326 ! delta_(y,i) * p_tot
2327 flux_rsy_vf(j, k, l, &
2328 & contxe + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i)/ga%R*b%R(norm_dir) &
2329 & + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i)*vel_l(norm_dir) &
2330 & - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
2331 & + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
2332 end do
2333 else if (bubbles_euler) then
2334
2335# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2336#if defined(MFC_OpenACC)
2337# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2338!$acc loop seq
2339# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2340#elif defined(MFC_OpenMP)
2341# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2342
2343# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2344#endif
2345 do i = 1, num_vels
2346 flux_rsy_vf(j, k, l, &
2347 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2348 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
2349 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
2350 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
2351 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
2352 end do
2353 else if (hypoelasticity) then
2354
2355# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2356#if defined(MFC_OpenACC)
2357# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2358!$acc loop seq
2359# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2360#elif defined(MFC_OpenMP)
2361# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2362
2363# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2364#endif
2365 do i = 1, num_vels
2366 flux_rsy_vf(j, k, l, &
2367 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2368 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
2369 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
2370 & *pres_l - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
2371 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
2372 end do
2373 else
2374
2375# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2376#if defined(MFC_OpenACC)
2377# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2378!$acc loop seq
2379# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2380#elif defined(MFC_OpenMP)
2381# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2382
2383# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2384#endif
2385 do i = 1, num_vels
2386 flux_rsy_vf(j, k, l, &
2387 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2388 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1)) &
2389 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l) &
2390 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
2391 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
2392 end do
2393 end if
2394
2395 ! Energy
2396 if (mhd .and. (.not. relativity)) then
2397 ! energy flux = (E + p + p_mag) * v_y - B_y * (v_x*B_x + v_y*B_y + v_z*B_z)
2398# 644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2399 flux_rsy_vf(j, k, l, &
2400 & e_idx) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
2401 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
2402 & - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir) &
2403 & *(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) + s_m*s_p*(e_l &
2404 & - e_r))/(s_m - s_p)
2405# 651 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2406 else if (mhd .and. relativity) then
2407 ! energy flux = m_y - mass flux Hard-coded for single-component for now
2408 flux_rsy_vf(j, k, l, &
2409 & e_idx) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
2410 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l &
2411 & - e_r))/(s_m - s_p)
2412 else if (bubbles_euler) then
2413 flux_rsy_vf(j, k, l, &
2414 & e_idx) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
2415 & - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m &
2416 & - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
2417 else if (hypoelasticity) then
2418 flux_tau_l = 0._wp; flux_tau_r = 0._wp
2419
2420# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2421#if defined(MFC_OpenACC)
2422# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2423!$acc loop seq
2424# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2425#elif defined(MFC_OpenMP)
2426# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2427
2428# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2429#endif
2430 do i = 1, num_dims
2431 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
2432 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
2433 end do
2434 flux_rsy_vf(j, k, l, &
2435 & e_idx) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
2436 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r)) &
2437 & /(s_m - s_p)
2438 else
2439 flux_rsy_vf(j, k, l, &
2440 & e_idx) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
2441 & + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
2442 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
2443 end if
2444
2445 ! Elastic Stresses
2446 if (hypoelasticity) then
2447 do i = 1, strxe - strxb + 1 ! TODO: this indexing may be slow
2448 flux_rsy_vf(j, k, l, &
2449 & strxb - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
2450 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
2451 & - rho_r*tau_e_r(i)))/(s_m - s_p)
2452 end do
2453 end if
2454
2455 ! Advection flux and source: interface velocity for volume fraction transport
2456
2457# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2458#if defined(MFC_OpenACC)
2459# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2460!$acc loop seq
2461# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2462#elif defined(MFC_OpenMP)
2463# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2464
2465# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2466#endif
2467 do i = advxb, advxe
2468 flux_rsy_vf(j, k, l, i) = (ql_prim_rsy_vf(j, k, l, i) - qr_prim_rsy_vf(j + 1, &
2469 & k, l, i))*s_m*s_p/(s_m - s_p)
2470 flux_src_rsy_vf(j, k, l, i) = (s_m*qr_prim_rsy_vf(j + 1, k, l, &
2471 & i) - s_p*ql_prim_rsy_vf(j, k, l, i))/(s_m - s_p)
2472 end do
2473
2474 if (bubbles_euler) then
2475 ! From HLLC: Kills mass transport @ bubble gas density
2476 if (num_fluids > 1) then
2477 flux_rsy_vf(j, k, l, contxe) = 0._wp
2478 end if
2479 end if
2480
2481 if (chemistry) then
2482
2483# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2484#if defined(MFC_OpenACC)
2485# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2486!$acc loop seq
2487# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2488#elif defined(MFC_OpenMP)
2489# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2490
2491# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2492#endif
2493 do i = chemxb, chemxe
2494 y_l = ql_prim_rsy_vf(j, k, l, i)
2495 y_r = qr_prim_rsy_vf(j + 1, k, l, i)
2496
2497 flux_rsy_vf(j, k, l, &
2498 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
2499 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
2500 flux_src_rsy_vf(j, k, l, i) = 0._wp
2501 end do
2502 end if
2503
2504 ! MHD: magnetic flux and Maxwell stress contributions
2505 if (mhd) then
2506 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
2507 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
2508
2509# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2510#if defined(MFC_OpenACC)
2511# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2512!$acc loop seq
2513# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2514#elif defined(MFC_OpenMP)
2515# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2516
2517# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2518#endif
2519 do i = 0, 1
2520 flux_rsx_vf(j, k, l, &
2521 & b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
2522 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
2523 & - b%R(2 + i)))/(s_m - s_p)
2524 end do
2525 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
2526 ! B_x d/dy flux = (1 - delta(x,y)) * (v_y * B_x - v_x * B_y) B_y
2527 ! d/dy flux = (1 - delta(y,y)) * (v_y * B_y - v_y * B_y) B_z d/dy
2528 ! flux = (1 - delta(z,y)) * (v_y * B_z - v_z * B_y)
2529
2530# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2531#if defined(MFC_OpenACC)
2532# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2533!$acc loop seq
2534# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2535#elif defined(MFC_OpenMP)
2536# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2537
2538# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2539#endif
2540 do i = 0, 2
2541 flux_rsy_vf(j, k, l, &
2542 & b_idx%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1) &
2543 & *b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1) &
2544 & *b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
2545 end do
2546
2547 if (hyper_cleaning) then
2548 ! propagate magnetic field divergence as a wave
2549 flux_rsy_vf(j, k, l, b_idx%beg + norm_dir - 1) = flux_rsy_vf(j, k, l, &
2550 & b_idx%beg + norm_dir - 1) + (s_m*qr_prim_rsy_vf(j + 1, k, l, &
2551 & psi_idx) - s_p*ql_prim_rsy_vf(j, k, l, psi_idx))/(s_m - s_p)
2552
2553 flux_rsy_vf(j, k, l, &
2554 & psi_idx) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) &
2555 & - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsy_vf(j, k, l, &
2556 & psi_idx) - qr_prim_rsy_vf(j + 1, k, l, psi_idx)))/(s_m - s_p)
2557 else
2558 flux_rsy_vf(j, k, l, &
2559 & b_idx%beg + norm_dir - 1) &
2560 & = 0._wp ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
2561 end if
2562 end if
2563 flux_src_rsy_vf(j, k, l, advxb) = 0._wp
2564 end if
2565
2566# 762 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2567 if (cyl_coord) then
2568 ! Substituting the advective flux into the inviscid geometrical source flux
2569
2570# 764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2571#if defined(MFC_OpenACC)
2572# 764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2573!$acc loop seq
2574# 764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2575#elif defined(MFC_OpenMP)
2576# 764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2577
2578# 764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2579#endif
2580 do i = 1, e_idx
2581 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
2582 end do
2583 ! Recalculating the radial momentum geometric source flux
2584 flux_gsrc_rsy_vf(j, k, l, contxe + 2) = flux_rsy_vf(j, k, l, &
2585 & contxe + 2) - (s_m*pres_r - s_p*pres_l)/(s_m - s_p)
2586 ! Geometrical source of the void fraction(s) is zero
2587
2588# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2589#if defined(MFC_OpenACC)
2590# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2591!$acc loop seq
2592# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2593#elif defined(MFC_OpenMP)
2594# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2595
2596# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2597#endif
2598 do i = advxb, advxe
2599 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
2600 end do
2601 end if
2602
2603 if (cyl_coord .and. hypoelasticity) then
2604 ! += tau_sigmasigma using HLL
2605 flux_gsrc_rsy_vf(j, k, l, contxe + 2) = flux_gsrc_rsy_vf(j, k, l, &
2606 & contxe + 2) + (s_m*tau_e_r(4) - s_p*tau_e_l(4))/(s_m - s_p)
2607
2608
2609# 783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2610#if defined(MFC_OpenACC)
2611# 783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2612!$acc loop seq
2613# 783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2614#elif defined(MFC_OpenMP)
2615# 783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2616
2617# 783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2618#endif
2619 do i = strxb, strxe
2620 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
2621 end do
2622 end if
2623# 789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2624 end do
2625 end do
2626 end do
2627
2628# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2629#if defined(MFC_OpenACC)
2630# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2631!$acc end parallel loop
2632# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2633#elif defined(MFC_OpenMP)
2634# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2635
2636# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2637!$omp end target teams loop
2638# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2639#endif
2640 end if
2641# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2642 if (norm_dir == 3) then
2643
2644# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2645
2646# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2647#if defined(MFC_OpenACC)
2648# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2649!$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)
2650# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2651#elif defined(MFC_OpenMP)
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
2656# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2657
2658# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2659!$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)
2660# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2661#endif
2662# 232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2663 do l = is3%beg, is3%end
2664 do k = is2%beg, is2%end
2665 do j = is1%beg, is1%end
2666
2667# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2668#if defined(MFC_OpenACC)
2669# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2670!$acc loop seq
2671# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2672#elif defined(MFC_OpenMP)
2673# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2674
2675# 235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2676#endif
2677 do i = 1, contxe
2678 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
2679 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
2680 end do
2681
2682 vel_l_rms = 0._wp; vel_r_rms = 0._wp
2683
2684
2685# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2686#if defined(MFC_OpenACC)
2687# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2688!$acc loop seq
2689# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2690#elif defined(MFC_OpenMP)
2691# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2692
2693# 243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2694#endif
2695 do i = 1, num_vels
2696 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
2697 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
2698 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
2699 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
2700 end do
2701
2702
2703# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2704#if defined(MFC_OpenACC)
2705# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2706!$acc loop seq
2707# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2708#elif defined(MFC_OpenMP)
2709# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2710
2711# 251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2712#endif
2713 do i = 1, num_fluids
2714 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
2715 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
2716 end do
2717
2718 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
2719 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
2720
2721 if (mhd) then
2722 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
2723 b%L(1) = bx0
2724 b%R(1) = bx0
2725 b%L(2) = ql_prim_rsz_vf(j, k, l, b_idx%beg)
2726 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg)
2727 b%L(3) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)
2728 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 1)
2729 else ! 2D/3D: Bx, By, Bz as variables
2730 b%L(1) = ql_prim_rsz_vf(j, k, l, b_idx%beg)
2731 b%R(1) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg)
2732 b%L(2) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)
2733 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 1)
2734 b%L(3) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 2)
2735 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 2)
2736 end if
2737 end if
2738
2739 rho_l = 0._wp
2740 gamma_l = 0._wp
2741 pi_inf_l = 0._wp
2742 qv_l = 0._wp
2743
2744 rho_r = 0._wp
2745 gamma_r = 0._wp
2746 pi_inf_r = 0._wp
2747 qv_r = 0._wp
2748
2749 alpha_l_sum = 0._wp
2750 alpha_r_sum = 0._wp
2751
2752 pres_mag%L = 0._wp
2753 pres_mag%R = 0._wp
2754
2755 if (mpp_lim) then
2756
2757# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2758#if defined(MFC_OpenACC)
2759# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2760!$acc loop seq
2761# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2762#elif defined(MFC_OpenMP)
2763# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2764
2765# 295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2766#endif
2767 do i = 1, num_fluids
2768 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
2769 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
2770 alpha_l_sum = alpha_l_sum + alpha_l(i)
2771 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
2772 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
2773 alpha_r_sum = alpha_r_sum + alpha_r(i)
2774 end do
2775
2776 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
2777 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
2778 end if
2779
2780
2781# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2782#if defined(MFC_OpenACC)
2783# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2784!$acc loop seq
2785# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2786#elif defined(MFC_OpenMP)
2787# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2788
2789# 309 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2790#endif
2791 do i = 1, num_fluids
2792 rho_l = rho_l + alpha_rho_l(i)
2793 gamma_l = gamma_l + alpha_l(i)*gammas(i)
2794 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
2795 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
2796
2797 rho_r = rho_r + alpha_rho_r(i)
2798 gamma_r = gamma_r + alpha_r(i)*gammas(i)
2799 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
2800 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
2801 end do
2802
2803 if (viscous) then
2804
2805# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2806#if defined(MFC_OpenACC)
2807# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2808!$acc loop seq
2809# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2810#elif defined(MFC_OpenMP)
2811# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2812
2813# 323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2814#endif
2815 do i = 1, 2
2816 re_l(i) = dflt_real
2817 re_r(i) = dflt_real
2818
2819 if (re_size(i) > 0) re_l(i) = 0._wp
2820 if (re_size(i) > 0) re_r(i) = 0._wp
2821
2822
2823# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2824#if defined(MFC_OpenACC)
2825# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2826!$acc loop seq
2827# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2828#elif defined(MFC_OpenMP)
2829# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2830
2831# 331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2832#endif
2833 do q = 1, re_size(i)
2834 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
2835 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
2836 end do
2837
2838 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
2839 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
2840 end do
2841 end if
2842
2843 if (chemistry) then
2844
2845# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2846#if defined(MFC_OpenACC)
2847# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2848!$acc loop seq
2849# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2850#elif defined(MFC_OpenMP)
2851# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2852
2853# 343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2854#endif
2855 do i = chemxb, chemxe
2856 ys_l(i - chemxb + 1) = ql_prim_rsz_vf(j, k, l, i)
2857 ys_r(i - chemxb + 1) = qr_prim_rsz_vf(j + 1, k, l, i)
2858 end do
2859
2860 call get_mixture_molecular_weight(ys_l, mw_l)
2861 call get_mixture_molecular_weight(ys_r, mw_r)
2862# 355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2863 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
2864 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
2865# 358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2866
2867 r_gas_l = gas_constant/mw_l
2868 r_gas_r = gas_constant/mw_r
2869 t_l = pres_l/rho_l/r_gas_l
2870 t_r = pres_r/rho_r/r_gas_r
2871
2872 call get_species_specific_heats_r(t_l, cp_il)
2873 call get_species_specific_heats_r(t_r, cp_ir)
2874
2875 if (chem_params%gamma_method == 1) then
2876 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
2877 gamma_il = cp_il/(cp_il - 1.0_wp)
2878 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
2879
2880 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
2881 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
2882 else if (chem_params%gamma_method == 2) then
2883 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
2884 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
2885 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
2886 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
2887 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
2888
2889 gamm_l = cp_l/cv_l
2890 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
2891 gamm_r = cp_r/cv_r
2892 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
2893 end if
2894
2895 call get_mixture_energy_mass(t_l, ys_l, e_l)
2896 call get_mixture_energy_mass(t_r, ys_r, e_r)
2897
2898 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
2899 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
2900 h_l = (e_l + pres_l)/rho_l
2901 h_r = (e_r + pres_r)/rho_r
2902 else if (mhd .and. relativity) then
2903 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
2904 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
2905# 398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2906 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
2907 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
2908
2909 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
2910 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
2911 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
2912 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
2913# 406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2914
2915 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
2916 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
2917
2918 ! Hard-coded EOS
2919 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
2920 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
2921# 414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2922 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
2923 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
2924# 417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2925
2926 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
2927 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
2928 else if (mhd .and. .not. relativity) then
2929# 422 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2930 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
2931 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
2932# 425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2933 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
2934 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r &
2935 & + pres_mag%R ! includes magnetic energy
2936 h_l = (e_l + pres_l - pres_mag%L)/rho_l
2937 h_r = (e_r + pres_r - pres_mag%R) &
2938 & /rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
2939 else
2940 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
2941 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
2942 h_l = (e_l + pres_l)/rho_l
2943 h_r = (e_r + pres_r)/rho_r
2944 end if
2945
2946 ! elastic energy update
2947 if (hypoelasticity) then
2948 g_l = 0._wp; g_r = 0._wp
2949
2950
2951# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2952#if defined(MFC_OpenACC)
2953# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2954!$acc loop seq
2955# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2956#elif defined(MFC_OpenMP)
2957# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2958
2959# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2960#endif
2961 do i = 1, num_fluids
2962 g_l = g_l + alpha_l(i)*gs_rs(i)
2963 g_r = g_r + alpha_r(i)*gs_rs(i)
2964 end do
2965
2966 if (cont_damage) then
2967 g_l = g_l*max((1._wp - ql_prim_rsz_vf(j, k, l, damage_idx)), 0._wp)
2968 g_r = g_r*max((1._wp - qr_prim_rsz_vf(j, k, l, damage_idx)), 0._wp)
2969 end if
2970
2971
2972# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2973#if defined(MFC_OpenACC)
2974# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2975!$acc loop seq
2976# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2977#elif defined(MFC_OpenMP)
2978# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2979
2980# 453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2981#endif
2982 do i = 1, strxe - strxb + 1
2983 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
2984 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
2985 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
2986 if ((g_l > 1000) .and. (g_r > 1000)) then
2987 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2988 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2989 ! Double for shear stresses
2990 if (any(strxb - 1 + i == shear_indices)) then
2991 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2992 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2993 end if
2994 end if
2995 end do
2996 end if
2997
2998 if (avg_state == 1) then
2999# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3000 rho_avg = sqrt(rho_l*rho_r)
3001# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3002
3003# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3004 vel_avg_rms = 0._wp
3005# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3006
3007# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3008
3009# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3010#if defined(MFC_OpenACC)
3011# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3012!$acc loop seq
3013# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3014#elif defined(MFC_OpenMP)
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#endif
3019# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3020 do i = 1, num_vels
3021# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3022 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
3023# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3024 end do
3025# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3026
3027# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3028 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
3029# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3030
3031# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3032 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
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 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
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 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_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 if (chemistry) then
3045# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3046 eps = 0.001_wp
3047# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3048 call get_species_enthalpies_rt(t_l, h_il)
3049# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3050 call get_species_enthalpies_rt(t_r, h_ir)
3051# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3052 h_il = h_il*gas_constant/molecular_weights*t_l
3053# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3054 h_ir = h_ir*gas_constant/molecular_weights*t_r
3055# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3056 call get_species_specific_heats_r(t_l, cp_il)
3057# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3058 call get_species_specific_heats_r(t_r, cp_ir)
3059# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3060
3061# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3062 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
3063# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3064 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
3065# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3066 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
3067# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3068 if (abs(t_l - t_r) < eps) then
3069# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3070 ! Case when T_L and T_R are very close
3071# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3072 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
3073# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3074 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
3075# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3076 & - gas_constant/molecular_weights(:)))
3077# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3078 else
3079# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3080 ! Normal calculation when T_L and T_R are sufficiently different
3081# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3082 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
3083# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3084 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
3085# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3086 end if
3087# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3088 gamma_avg = cp_avg/cv_avg
3089# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3090
3091# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3092 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
3093# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3094 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
3095# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3096 end if
3097# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3098 end if
3099# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3100
3101# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3102 if (avg_state == 2) then
3103# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3104 rho_avg = 5.e-1_wp*(rho_l + rho_r)
3105# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3106 vel_avg_rms = 0._wp
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 defined(MFC_OpenACC)
3111# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3112!$acc loop seq
3113# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3114#elif defined(MFC_OpenMP)
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#endif
3119# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3120 do i = 1, num_vels
3121# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3122 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
3123# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3124 end do
3125# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3126
3127# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3128 h_avg = 5.e-1_wp*(h_l + h_r)
3129# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3130 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
3131# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3132 qv_avg = 5.e-1_wp*(qv_l + qv_r)
3133# 470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3134 end if
3135
3136 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, &
3137 & qv_l)
3138
3139 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, &
3140 & qv_r)
3141
3142 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
3143 ! variables are placeholders to call the subroutine.
3144
3145 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
3146 & c_sum_yi_phi, c_avg, qv_avg)
3147
3148 if (mhd) then
3149 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
3150 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
3151 end if
3152
3153 if (viscous) then
3154 if (chemistry) then
3155 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
3156 end if
3157
3158# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3159#if defined(MFC_OpenACC)
3160# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3161!$acc loop seq
3162# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3163#elif defined(MFC_OpenMP)
3164# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3165
3166# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3167#endif
3168 do i = 1, 2
3169 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3170 end do
3171 end if
3172
3173 ! Wave speed estimates (wave_speeds=1: direct, wave_speeds=2: pressure-based)
3174 if (wave_speeds == 1) then
3175 if (mhd) then
3176 ! MHD: use fast magnetosonic speed
3177 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
3178 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
3179 else if (hypoelasticity) then
3180 ! Elastic wave speed, Rodriguez et al. JCP (2019)
3181 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))) &
3182 & /rho_l), &
3183 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
3184 & /rho_r))
3185 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))) &
3186 & /rho_r), &
3187 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
3188 & /rho_l))
3189 else if (hyperelasticity) then
3190 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l), &
3191 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
3192 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r), &
3193 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
3194 else
3195 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3196 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3197 end if
3198
3199 if (hyper_cleaning) then
3200 ! Dedner GLM divergence cleaning, Dedner et al. JCP (2002)
3201 s_l = min(s_l, -hyper_cleaning_speed)
3202 s_r = max(s_r, hyper_cleaning_speed)
3203 end if
3204
3205 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
3206 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
3207 & - rho_r*(s_r - vel_r(dir_idx(1))))
3208 else if (wave_speeds == 2) then
3209 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3210
3211 pres_sr = pres_sl
3212
3213 ! Low Mach correction: Thornber et al. JCP (2008)
3214 ms_l = max(1._wp, &
3215 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
3216 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
3217 ms_r = max(1._wp, &
3218 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
3219 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
3220
3221 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3222 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3223
3224 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
3225 end if
3226
3227 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3228
3229 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, &
3230 & s_r))
3231 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, &
3232 & s_r))
3233
3234 ! 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
3235 if (low_mach == 1) then
3236 if (riemann_solver == 1 .or. riemann_solver == 5) then
3237# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3238 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3239# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3240 pcorr = 0._wp
3241# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3242
3243# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3244 if (low_mach == 1) then
3245# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3246 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3247# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3248 end if
3249# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3250 else if (riemann_solver == 2) then
3251# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3252 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3253# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3254 pcorr = 0._wp
3255# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3256
3257# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3258 if (low_mach == 1) then
3259# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3260 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))) &
3261# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3262 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3263# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3264 else if (low_mach == 2) then
3265# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3266 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))))
3267# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3268 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))))
3269# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3270 vel_l(dir_idx(1)) = vel_l_tmp
3271# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3272 vel_r(dir_idx(1)) = vel_r_tmp
3273# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3274 end if
3275# 562 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3276 end if
3277 else
3278 pcorr = 0._wp
3279 end if
3280
3281 ! Mass
3282 if (.not. relativity) then
3283
3284# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3285#if defined(MFC_OpenACC)
3286# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3287!$acc loop seq
3288# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3289#elif defined(MFC_OpenMP)
3290# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3291
3292# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3293#endif
3294 do i = 1, contxe
3295 flux_rsz_vf(j, k, l, &
3296 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i) &
3297 & *vel_l(norm_dir) + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
3298 end do
3299 else if (relativity) then
3300
3301# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3302#if defined(MFC_OpenACC)
3303# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3304!$acc loop seq
3305# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3306#elif defined(MFC_OpenMP)
3307# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3308
3309# 576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3310#endif
3311 do i = 1, contxe
3312 flux_rsz_vf(j, k, l, &
3313 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
3314 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i))) &
3315 & /(s_m - s_p)
3316 end do
3317 end if
3318
3319 ! Momentum
3320 if (mhd .and. (.not. relativity)) then
3321
3322# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3323#if defined(MFC_OpenACC)
3324# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3325!$acc loop seq
3326# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3327#elif defined(MFC_OpenMP)
3328# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3329
3330# 587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3331#endif
3332 do i = 1, 3
3333 ! Flux of rho*v_i in the z direction = rho * v_i * v_z - B_i * B_z +
3334 ! delta_(z,i) * p_tot
3335 flux_rsz_vf(j, k, l, &
3336 & contxe + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i)*b%R(norm_dir) &
3337 & + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
3338 & - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
3339 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
3340 end do
3341 else if (mhd .and. relativity) then
3342
3343# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3344#if defined(MFC_OpenACC)
3345# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3346!$acc loop seq
3347# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3348#elif defined(MFC_OpenMP)
3349# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3350
3351# 598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3352#endif
3353 do i = 1, 3
3354 ! Flux of m_i in the z direction = m_i * v_z - b_i/Gamma * B_z +
3355 ! delta_(z,i) * p_tot
3356 flux_rsz_vf(j, k, l, &
3357 & contxe + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i)/ga%R*b%R(norm_dir) &
3358 & + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i)*vel_l(norm_dir) &
3359 & - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
3360 & + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
3361 end do
3362 else if (bubbles_euler) then
3363
3364# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3365#if defined(MFC_OpenACC)
3366# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3367!$acc loop seq
3368# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3369#elif defined(MFC_OpenMP)
3370# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3371
3372# 609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3373#endif
3374 do i = 1, num_vels
3375 flux_rsz_vf(j, k, l, &
3376 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
3377 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
3378 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
3379 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
3380 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
3381 end do
3382 else if (hypoelasticity) then
3383
3384# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3385#if defined(MFC_OpenACC)
3386# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3387!$acc loop seq
3388# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3389#elif defined(MFC_OpenMP)
3390# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3391
3392# 619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3393#endif
3394 do i = 1, num_vels
3395 flux_rsz_vf(j, k, l, &
3396 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
3397 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
3398 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
3399 & *pres_l - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
3400 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
3401 end do
3402 else
3403
3404# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3405#if defined(MFC_OpenACC)
3406# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3407!$acc loop seq
3408# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3409#elif defined(MFC_OpenMP)
3410# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3411
3412# 629 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3413#endif
3414 do i = 1, num_vels
3415 flux_rsz_vf(j, k, l, &
3416 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
3417 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1)) &
3418 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l) &
3419 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
3420 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
3421 end do
3422 end if
3423
3424 ! Energy
3425 if (mhd .and. (.not. relativity)) then
3426 ! energy flux = (E + p + p_mag) * v_z - B_z * (v_x*B_x + v_y*B_y + v_z*B_z)
3427# 644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3428 flux_rsz_vf(j, k, l, &
3429 & e_idx) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
3430 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
3431 & - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir) &
3432 & *(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) + s_m*s_p*(e_l &
3433 & - e_r))/(s_m - s_p)
3434# 651 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3435 else if (mhd .and. relativity) then
3436 ! energy flux = m_z - mass flux Hard-coded for single-component for now
3437 flux_rsz_vf(j, k, l, &
3438 & e_idx) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
3439 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l &
3440 & - e_r))/(s_m - s_p)
3441 else if (bubbles_euler) then
3442 flux_rsz_vf(j, k, l, &
3443 & e_idx) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
3444 & - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m &
3445 & - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
3446 else if (hypoelasticity) then
3447 flux_tau_l = 0._wp; flux_tau_r = 0._wp
3448
3449# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3450#if defined(MFC_OpenACC)
3451# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3452!$acc loop seq
3453# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3454#elif defined(MFC_OpenMP)
3455# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3456
3457# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3458#endif
3459 do i = 1, num_dims
3460 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
3461 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
3462 end do
3463 flux_rsz_vf(j, k, l, &
3464 & e_idx) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
3465 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r)) &
3466 & /(s_m - s_p)
3467 else
3468 flux_rsz_vf(j, k, l, &
3469 & e_idx) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
3470 & + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
3471 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
3472 end if
3473
3474 ! Elastic Stresses
3475 if (hypoelasticity) then
3476 do i = 1, strxe - strxb + 1 ! TODO: this indexing may be slow
3477 flux_rsz_vf(j, k, l, &
3478 & strxb - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
3479 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
3480 & - rho_r*tau_e_r(i)))/(s_m - s_p)
3481 end do
3482 end if
3483
3484 ! Advection flux and source: interface velocity for volume fraction transport
3485
3486# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3487#if defined(MFC_OpenACC)
3488# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3489!$acc loop seq
3490# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3491#elif defined(MFC_OpenMP)
3492# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3493
3494# 691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3495#endif
3496 do i = advxb, advxe
3497 flux_rsz_vf(j, k, l, i) = (ql_prim_rsz_vf(j, k, l, i) - qr_prim_rsz_vf(j + 1, &
3498 & k, l, i))*s_m*s_p/(s_m - s_p)
3499 flux_src_rsz_vf(j, k, l, i) = (s_m*qr_prim_rsz_vf(j + 1, k, l, &
3500 & i) - s_p*ql_prim_rsz_vf(j, k, l, i))/(s_m - s_p)
3501 end do
3502
3503 if (bubbles_euler) then
3504 ! From HLLC: Kills mass transport @ bubble gas density
3505 if (num_fluids > 1) then
3506 flux_rsz_vf(j, k, l, contxe) = 0._wp
3507 end if
3508 end if
3509
3510 if (chemistry) then
3511
3512# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3513#if defined(MFC_OpenACC)
3514# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3515!$acc loop seq
3516# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3517#elif defined(MFC_OpenMP)
3518# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3519
3520# 707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3521#endif
3522 do i = chemxb, chemxe
3523 y_l = ql_prim_rsz_vf(j, k, l, i)
3524 y_r = qr_prim_rsz_vf(j + 1, k, l, i)
3525
3526 flux_rsz_vf(j, k, l, &
3527 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
3528 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
3529 flux_src_rsz_vf(j, k, l, i) = 0._wp
3530 end do
3531 end if
3532
3533 ! MHD: magnetic flux and Maxwell stress contributions
3534 if (mhd) then
3535 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
3536 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
3537
3538# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3539#if defined(MFC_OpenACC)
3540# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3541!$acc loop seq
3542# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3543#elif defined(MFC_OpenMP)
3544# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3545
3546# 723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3547#endif
3548 do i = 0, 1
3549 flux_rsx_vf(j, k, l, &
3550 & b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
3551 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
3552 & - b%R(2 + i)))/(s_m - s_p)
3553 end do
3554 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
3555 ! B_x d/dz flux = (1 - delta(x,z)) * (v_z * B_x - v_x * B_z) B_y
3556 ! d/dz flux = (1 - delta(y,z)) * (v_z * B_y - v_y * B_z) B_z d/dz
3557 ! flux = (1 - delta(z,z)) * (v_z * B_z - v_z * B_z)
3558
3559# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3560#if defined(MFC_OpenACC)
3561# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3562!$acc loop seq
3563# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3564#elif defined(MFC_OpenMP)
3565# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3566
3567# 734 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3568#endif
3569 do i = 0, 2
3570 flux_rsz_vf(j, k, l, &
3571 & b_idx%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1) &
3572 & *b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1) &
3573 & *b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
3574 end do
3575
3576 if (hyper_cleaning) then
3577 ! propagate magnetic field divergence as a wave
3578 flux_rsz_vf(j, k, l, b_idx%beg + norm_dir - 1) = flux_rsz_vf(j, k, l, &
3579 & b_idx%beg + norm_dir - 1) + (s_m*qr_prim_rsz_vf(j + 1, k, l, &
3580 & psi_idx) - s_p*ql_prim_rsz_vf(j, k, l, psi_idx))/(s_m - s_p)
3581
3582 flux_rsz_vf(j, k, l, &
3583 & psi_idx) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) &
3584 & - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsz_vf(j, k, l, &
3585 & psi_idx) - qr_prim_rsz_vf(j + 1, k, l, psi_idx)))/(s_m - s_p)
3586 else
3587 flux_rsz_vf(j, k, l, &
3588 & b_idx%beg + norm_dir - 1) &
3589 & = 0._wp ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
3590 end if
3591 end if
3592 flux_src_rsz_vf(j, k, l, advxb) = 0._wp
3593 end if
3594
3595# 789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3596 end do
3597 end do
3598 end do
3599
3600# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3601#if defined(MFC_OpenACC)
3602# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3603!$acc end parallel loop
3604# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3605#elif defined(MFC_OpenMP)
3606# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3607
3608# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3609!$omp end target teams loop
3610# 792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3611#endif
3612 end if
3613# 795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3614
3615 if (viscous .or. dummy) then
3616 if (weno_re_flux) then
3617 call s_compute_viscous_source_flux(ql_prim_vf(momxb:momxe), dql_prim_dx_vf(momxb:momxe), &
3618 & dql_prim_dy_vf(momxb:momxe), dql_prim_dz_vf(momxb:momxe), &
3619 & qr_prim_vf(momxb:momxe), dqr_prim_dx_vf(momxb:momxe), &
3620 & dqr_prim_dy_vf(momxb:momxe), dqr_prim_dz_vf(momxb:momxe), flux_src_vf, &
3621 & norm_dir, ix, iy, iz)
3622 else
3623 call s_compute_viscous_source_flux(q_prim_vf(momxb:momxe), dql_prim_dx_vf(momxb:momxe), &
3624 & dql_prim_dy_vf(momxb:momxe), dql_prim_dz_vf(momxb:momxe), &
3625 & q_prim_vf(momxb:momxe), dqr_prim_dx_vf(momxb:momxe), &
3626 & dqr_prim_dy_vf(momxb:momxe), dqr_prim_dz_vf(momxb:momxe), flux_src_vf, &
3627 & norm_dir, ix, iy, iz)
3628 end if
3629 end if
3630
3631 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
3632
3633 end subroutine s_hll_riemann_solver
3634
3635 !> Lax-Friedrichs (Rusanov) approximate Riemann solver
3636 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, &
3637
3638 & 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, &
3639 & dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
3640
3641 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, ql_prim_rsy_vf, &
3642 & qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf
3643 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
3644 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
3645 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
3646 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
3647
3648 ! Intercell fluxes
3649 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
3650 real(wp) :: flux_tau_l, flux_tau_r
3651 integer, intent(in) :: norm_dir
3652 type(int_bounds_info), intent(in) :: ix, iy, iz
3653
3654# 844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3655 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
3656 real(wp), dimension(num_vels) :: vel_l, vel_r
3657 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
3658 real(wp), dimension(num_species) :: ys_l, ys_r
3659 real(wp), dimension(num_species) :: cp_il, cp_ir, xs_l, xs_r, gamma_il, gamma_ir
3660 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
3661 !> Averaged velocity gradient tensor `d(vel_i)/d(coord_j)`.
3662 real(wp), dimension(num_dims, num_dims) :: vel_grad_l, vel_grad_r
3663# 853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3664 real(wp) :: rho_l, rho_r
3665 real(wp) :: pres_l, pres_r
3666 real(wp) :: e_l, e_r
3667 real(wp) :: h_l, h_r
3668 real(wp) :: cp_avg, cv_avg, t_avg, eps, c_sum_yi_phi
3669 real(wp) :: t_l, t_r
3670 real(wp) :: y_l, y_r
3671 real(wp) :: mw_l, mw_r
3672 real(wp) :: r_gas_l, r_gas_r
3673 real(wp) :: cp_l, cp_r
3674 real(wp) :: cv_l, cv_r
3675 real(wp) :: gamm_l, gamm_r
3676 real(wp) :: gamma_l, gamma_r
3677 real(wp) :: pi_inf_l, pi_inf_r
3678 real(wp) :: qv_l, qv_r
3679 real(wp) :: c_l, c_r
3680 real(wp), dimension(6) :: tau_e_l, tau_e_r
3681 real(wp) :: g_l, g_r
3682 real(wp), dimension(2) :: re_l, re_r
3683 real(wp), dimension(3) :: xi_field_l, xi_field_r
3684 real(wp) :: rho_avg
3685 real(wp) :: h_avg
3686 real(wp) :: gamma_avg
3687 real(wp) :: c_avg
3688 real(wp) :: s_l, s_r, s_m, s_p, s_s
3689 real(wp) :: xi_m, xi_p
3690 real(wp) :: ptilde_l, ptilde_r
3691 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
3692 real(wp) :: vel_l_tmp, vel_r_tmp
3693 real(wp) :: ms_l, ms_r, pres_sl, pres_sr
3694 real(wp) :: alpha_l_sum, alpha_r_sum
3695 real(wp) :: zcoef, pcorr !< low Mach number correction
3696 type(riemann_states) :: c_fast, pres_mag
3697 type(riemann_states_vec3) :: b
3698 type(riemann_states) :: ga !< Gamma (Lorentz factor)
3699 type(riemann_states) :: vdotb, b2
3700 type(riemann_states_vec3) :: b4 !< 4-magnetic field components (spatial: b4x, b4y, b4z)
3701 type(riemann_states_vec3) :: cm !< Conservative momentum variables
3702 integer :: i, j, k, l, q !< Generic loop iterators
3703 integer, dimension(3) :: idx_right_phys !< Physical (j,k,l) indices for right state.
3704 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
3705
3706 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
3707 & 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, &
3708 & dqr_prim_dz_vf, norm_dir, ix, iy, iz)
3709
3710 ! Reshaping inputted data based on dimensional splitting direction
3711 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
3712# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3713 if (norm_dir == 1) then
3714
3715# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3716
3717# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3718#if defined(MFC_OpenACC)
3719# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3720!$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)
3721# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3722#elif defined(MFC_OpenMP)
3723# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3724
3725# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3726
3727# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3728
3729# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3730!$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)
3731# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3732#endif
3733# 912 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3734 do l = is3%beg, is3%end
3735 do k = is2%beg, is2%end
3736 do j = is1%beg, is1%end
3737
3738# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3739#if defined(MFC_OpenACC)
3740# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3741!$acc loop seq
3742# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3743#elif defined(MFC_OpenMP)
3744# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3745
3746# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3747#endif
3748 do i = 1, contxe
3749 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
3750 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
3751 end do
3752
3753 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3754
3755
3756# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3757#if defined(MFC_OpenACC)
3758# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3759!$acc loop seq
3760# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3761#elif defined(MFC_OpenMP)
3762# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3763
3764# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3765#endif
3766 do i = 1, num_vels
3767 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
3768 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
3769 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3770 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3771 end do
3772
3773
3774# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3775#if defined(MFC_OpenACC)
3776# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3777!$acc loop seq
3778# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3779#elif defined(MFC_OpenMP)
3780# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3781
3782# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3783#endif
3784 do i = 1, num_fluids
3785 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
3786 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
3787 end do
3788
3789 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
3790 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
3791
3792 if (mhd) then
3793 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
3794 b%L(1) = bx0
3795 b%R(1) = bx0
3796 b%L(2) = ql_prim_rsx_vf(j, k, l, b_idx%beg)
3797 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg)
3798 b%L(3) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)
3799 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 1)
3800 else ! 2D/3D: Bx, By, Bz as variables
3801 b%L(1) = ql_prim_rsx_vf(j, k, l, b_idx%beg)
3802 b%R(1) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg)
3803 b%L(2) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)
3804 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 1)
3805 b%L(3) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 2)
3806 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 2)
3807 end if
3808 end if
3809
3810 rho_l = 0._wp
3811 gamma_l = 0._wp
3812 pi_inf_l = 0._wp
3813 qv_l = 0._wp
3814
3815 rho_r = 0._wp
3816 gamma_r = 0._wp
3817 pi_inf_r = 0._wp
3818 qv_r = 0._wp
3819
3820 alpha_l_sum = 0._wp
3821 alpha_r_sum = 0._wp
3822
3823 pres_mag%L = 0._wp
3824 pres_mag%R = 0._wp
3825
3826 if (mpp_lim) then
3827
3828# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3829#if defined(MFC_OpenACC)
3830# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3831!$acc loop seq
3832# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3833#elif defined(MFC_OpenMP)
3834# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3835
3836# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3837#endif
3838 do i = 1, num_fluids
3839 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
3840 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
3841 alpha_l_sum = alpha_l_sum + alpha_l(i)
3842 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
3843 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
3844 alpha_r_sum = alpha_r_sum + alpha_r(i)
3845 end do
3846
3847 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
3848 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
3849 end if
3850
3851
3852# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3853#if defined(MFC_OpenACC)
3854# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3855!$acc loop seq
3856# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3857#elif defined(MFC_OpenMP)
3858# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3859
3860# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3861#endif
3862 do i = 1, num_fluids
3863 rho_l = rho_l + alpha_rho_l(i)
3864 gamma_l = gamma_l + alpha_l(i)*gammas(i)
3865 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
3866 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
3867
3868 rho_r = rho_r + alpha_rho_r(i)
3869 gamma_r = gamma_r + alpha_r(i)*gammas(i)
3870 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
3871 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
3872 end do
3873
3874 if (viscous) then
3875
3876# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3877#if defined(MFC_OpenACC)
3878# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3879!$acc loop seq
3880# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3881#elif defined(MFC_OpenMP)
3882# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3883
3884# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3885#endif
3886 do i = 1, 2
3887 re_l(i) = dflt_real
3888 re_r(i) = dflt_real
3889
3890 if (re_size(i) > 0) re_l(i) = 0._wp
3891 if (re_size(i) > 0) re_r(i) = 0._wp
3892
3893
3894# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3895#if defined(MFC_OpenACC)
3896# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3897!$acc loop seq
3898# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3899#elif defined(MFC_OpenMP)
3900# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3901
3902# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3903#endif
3904 do q = 1, re_size(i)
3905 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
3906 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
3907 end do
3908
3909 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
3910 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
3911 end do
3912 end if
3913
3914 if (chemistry) then
3915
3916# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3917#if defined(MFC_OpenACC)
3918# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3919!$acc loop seq
3920# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3921#elif defined(MFC_OpenMP)
3922# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3923
3924# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3925#endif
3926 do i = chemxb, chemxe
3927 ys_l(i - chemxb + 1) = ql_prim_rsx_vf(j, k, l, i)
3928 ys_r(i - chemxb + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
3929 end do
3930
3931 call get_mixture_molecular_weight(ys_l, mw_l)
3932 call get_mixture_molecular_weight(ys_r, mw_r)
3933
3934# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3935 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
3936 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
3937# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3938
3939 r_gas_l = gas_constant/mw_l
3940 r_gas_r = gas_constant/mw_r
3941 t_l = pres_l/rho_l/r_gas_l
3942 t_r = pres_r/rho_r/r_gas_r
3943
3944 call get_species_specific_heats_r(t_l, cp_il)
3945 call get_species_specific_heats_r(t_r, cp_ir)
3946
3947 if (chem_params%gamma_method == 1) then
3948 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
3949 gamma_il = cp_il/(cp_il - 1.0_wp)
3950 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
3951
3952 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
3953 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
3954 else if (chem_params%gamma_method == 2) then
3955 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
3956 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
3957 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
3958 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
3959 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
3960
3961 gamm_l = cp_l/cv_l
3962 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
3963 gamm_r = cp_r/cv_r
3964 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
3965 end if
3966
3967 call get_mixture_energy_mass(t_l, ys_l, e_l)
3968 call get_mixture_energy_mass(t_r, ys_r, e_r)
3969
3970 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
3971 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
3972 h_l = (e_l + pres_l)/rho_l
3973 h_r = (e_r + pres_r)/rho_r
3974 else if (mhd .and. relativity) then
3975# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3976 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
3977 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
3978 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
3979 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
3980
3981 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
3982 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
3983 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
3984 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
3985
3986 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
3987 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
3988
3989 ! Hard-coded EOS
3990 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
3991 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
3992
3993 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
3994 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
3995
3996 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
3997 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
3998# 1100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3999 else if (mhd .and. .not. relativity) then
4000 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
4001 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
4002 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
4003 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r &
4004 & + pres_mag%R ! includes magnetic energy
4005 h_l = (e_l + pres_l - pres_mag%L)/rho_l
4006 h_r = (e_r + pres_r - pres_mag%R) &
4007 & /rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
4008 else
4009 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
4010 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
4011 h_l = (e_l + pres_l)/rho_l
4012 h_r = (e_r + pres_r)/rho_r
4013 end if
4014
4015 ! elastic energy update
4016 if (hypoelasticity) then
4017 g_l = 0._wp; g_r = 0._wp
4018
4019
4020# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4021#if defined(MFC_OpenACC)
4022# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4023!$acc loop seq
4024# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4025#elif defined(MFC_OpenMP)
4026# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4027
4028# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4029#endif
4030 do i = 1, num_fluids
4031 g_l = g_l + alpha_l(i)*gs_rs(i)
4032 g_r = g_r + alpha_r(i)*gs_rs(i)
4033 end do
4034
4035 if (cont_damage) then
4036 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, damage_idx)), 0._wp)
4037 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, damage_idx)), 0._wp)
4038 end if
4039
4040 do i = 1, strxe - strxb + 1
4041 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
4042 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
4043 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
4044 if ((g_l > 1000) .and. (g_r > 1000)) then
4045 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4046 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4047 ! Double for shear stresses
4048 if (any(strxb - 1 + i == shear_indices)) then
4049 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4050 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4051 end if
4052 end if
4053 end do
4054 end if
4055
4056 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, &
4057 & qv_l)
4058
4059 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, &
4060 & qv_r)
4061
4062 if (mhd) then
4063 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
4064 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
4065 end if
4066
4067 s_l = 0._wp; s_r = 0._wp
4068
4069
4070# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4071#if defined(MFC_OpenACC)
4072# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4073!$acc loop seq
4074# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4075#elif defined(MFC_OpenMP)
4076# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4077
4078# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4079#endif
4080 do i = 1, num_dims
4081 s_l = s_l + vel_l(i)**2._wp
4082 s_r = s_r + vel_r(i)**2._wp
4083 end do
4084
4085 s_l = sqrt(s_l)
4086 s_r = sqrt(s_r)
4087
4088 s_p = max(s_l, s_r) + max(c_l, c_r)
4089 s_m = -s_p
4090
4091 s_l = s_m
4092 s_r = s_p
4093
4094 ! Low Mach correction
4095 if (low_mach == 1) then
4096 if (riemann_solver == 1 .or. riemann_solver == 5) then
4097# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4098 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4099# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4100 pcorr = 0._wp
4101# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4102
4103# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4104 if (low_mach == 1) then
4105# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4106 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4107# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4108 end if
4109# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4110 else if (riemann_solver == 2) then
4111# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4112 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4113# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4114 pcorr = 0._wp
4115# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4116
4117# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4118 if (low_mach == 1) then
4119# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4120 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))) &
4121# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4122 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
4123# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4124 else if (low_mach == 2) then
4125# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4126 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))))
4127# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4128 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))))
4129# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4130 vel_l(dir_idx(1)) = vel_l_tmp
4131# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4132 vel_r(dir_idx(1)) = vel_r_tmp
4133# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4134 end if
4135# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4136 end if
4137 else
4138 pcorr = 0._wp
4139 end if
4140
4141 ! Mass
4142 if (.not. relativity) then
4143
4144# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4145#if defined(MFC_OpenACC)
4146# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4147!$acc loop seq
4148# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4149#elif defined(MFC_OpenMP)
4150# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4151
4152# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4153#endif
4154 do i = 1, contxe
4155 flux_rsx_vf(j, k, l, &
4156 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i) &
4157 & *vel_l(norm_dir) + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
4158 end do
4159 else if (relativity) then
4160
4161# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4162#if defined(MFC_OpenACC)
4163# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4164!$acc loop seq
4165# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4166#elif defined(MFC_OpenMP)
4167# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4168
4169# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4170#endif
4171 do i = 1, contxe
4172 flux_rsx_vf(j, k, l, &
4173 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
4174 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i))) &
4175 & /(s_m - s_p)
4176 end do
4177 end if
4178
4179 ! Momentum
4180 if (mhd .and. (.not. relativity)) then
4181
4182# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4183#if defined(MFC_OpenACC)
4184# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4185!$acc loop seq
4186# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4187#elif defined(MFC_OpenMP)
4188# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4189
4190# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4191#endif
4192 do i = 1, 3
4193 ! Flux of rho*v_i in the x direction = rho * v_i * v_x - B_i * B_x +
4194 ! delta_(x,i) * p_tot
4195 flux_rsx_vf(j, k, l, &
4196 & contxe + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i)*b%R(norm_dir) &
4197 & + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
4198 & - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
4199 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
4200 end do
4201 else if (mhd .and. relativity) then
4202
4203# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4204#if defined(MFC_OpenACC)
4205# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4206!$acc loop seq
4207# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4208#elif defined(MFC_OpenMP)
4209# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4210
4211# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4212#endif
4213 do i = 1, 3
4214 ! Flux of m_i in the x direction = m_i * v_x - b_i/Gamma * B_x +
4215 ! delta_(x,i) * p_tot
4216 flux_rsx_vf(j, k, l, &
4217 & contxe + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i)/ga%R*b%R(norm_dir) &
4218 & + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i)*vel_l(norm_dir) &
4219 & - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
4220 & + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
4221 end do
4222 else if (bubbles_euler) then
4223
4224# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4225#if defined(MFC_OpenACC)
4226# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4227!$acc loop seq
4228# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4229#elif defined(MFC_OpenMP)
4230# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4231
4232# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4233#endif
4234 do i = 1, num_vels
4235 flux_rsx_vf(j, k, l, &
4236 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4237 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
4238 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
4239 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
4240 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4241 end do
4242 else if (hypoelasticity) then
4243
4244# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4245#if defined(MFC_OpenACC)
4246# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4247!$acc loop seq
4248# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4249#elif defined(MFC_OpenMP)
4250# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4251
4252# 1234 "/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 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4257 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
4258 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
4259 & *pres_l - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4260 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
4261 end do
4262 else
4263
4264# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4265#if defined(MFC_OpenACC)
4266# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4267!$acc loop seq
4268# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4269#elif defined(MFC_OpenMP)
4270# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4271
4272# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4273#endif
4274 do i = 1, num_vels
4275 flux_rsx_vf(j, k, l, &
4276 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4277 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1)) &
4278 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l) &
4279 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
4280 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4281 end do
4282 end if
4283
4284 ! Energy
4285 if (mhd .and. (.not. relativity)) then
4286 ! energy flux = (E + p + p_mag) * v_x - B_x * (v_x*B_x + v_y*B_y + v_z*B_z)
4287# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4288 flux_rsx_vf(j, k, l, &
4289 & e_idx) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
4290 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
4291 & - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir) &
4292 & *(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) + s_m*s_p*(e_l &
4293 & - e_r))/(s_m - s_p)
4294# 1266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4295 else if (mhd .and. relativity) then
4296 ! energy flux = m_x - mass flux Hard-coded for single-component for now
4297 flux_rsx_vf(j, k, l, &
4298 & e_idx) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
4299 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l &
4300 & - e_r))/(s_m - s_p)
4301 else if (bubbles_euler) then
4302 flux_rsx_vf(j, k, l, &
4303 & e_idx) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
4304 & - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m &
4305 & - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
4306 else if (hypoelasticity) then
4307 flux_tau_l = 0._wp; flux_tau_r = 0._wp
4308
4309# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4310#if defined(MFC_OpenACC)
4311# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4312!$acc loop seq
4313# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4314#elif defined(MFC_OpenMP)
4315# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4316
4317# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4318#endif
4319 do i = 1, num_dims
4320 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
4321 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
4322 end do
4323 flux_rsx_vf(j, k, l, &
4324 & e_idx) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
4325 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r)) &
4326 & /(s_m - s_p)
4327 else
4328 flux_rsx_vf(j, k, l, &
4329 & e_idx) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
4330 & + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
4331 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
4332 end if
4333
4334 ! Elastic Stresses
4335 if (hypoelasticity) then
4336 do i = 1, strxe - strxb + 1 ! TODO: this indexing may be slow
4337 flux_rsx_vf(j, k, l, &
4338 & strxb - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
4339 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
4340 & - rho_r*tau_e_r(i)))/(s_m - s_p)
4341 end do
4342 end if
4343
4344 ! Advection flux and source: interface velocity for volume fraction transport
4345
4346# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4347#if defined(MFC_OpenACC)
4348# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4349!$acc loop seq
4350# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4351#elif defined(MFC_OpenMP)
4352# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4353
4354# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4355#endif
4356 do i = advxb, advxe
4357 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j + 1, &
4358 & k, l, i))*s_m*s_p/(s_m - s_p)
4359 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j + 1, k, l, &
4360 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
4361 end do
4362
4363 if (bubbles_euler) then
4364 ! From HLLC: Kills mass transport @ bubble gas density
4365 if (num_fluids > 1) then
4366 flux_rsx_vf(j, k, l, contxe) = 0._wp
4367 end if
4368 end if
4369
4370 if (chemistry) then
4371
4372# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4373#if defined(MFC_OpenACC)
4374# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4375!$acc loop seq
4376# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4377#elif defined(MFC_OpenMP)
4378# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4379
4380# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4381#endif
4382 do i = chemxb, chemxe
4383 y_l = ql_prim_rsx_vf(j, k, l, i)
4384 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
4385
4386 flux_rsx_vf(j, k, l, &
4387 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
4388 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
4389 flux_src_rsx_vf(j, k, l, i) = 0._wp
4390 end do
4391 end if
4392
4393 ! MHD: magnetic flux and Maxwell stress contributions
4394 if (mhd) then
4395 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
4396 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
4397
4398# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4399#if defined(MFC_OpenACC)
4400# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4401!$acc loop seq
4402# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4403#elif defined(MFC_OpenMP)
4404# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4405
4406# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4407#endif
4408 do i = 0, 1
4409 flux_rsx_vf(j, k, l, &
4410 & b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
4411 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
4412 & - b%R(2 + i)))/(s_m - s_p)
4413 end do
4414 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
4415 ! B_x d/dx flux = (1 - delta(x,x)) * (v_x * B_x - v_x * B_x) B_y
4416 ! d/dx flux = (1 - delta(y,x)) * (v_x * B_y - v_y * B_x) B_z d/dx
4417 ! flux = (1 - delta(z,x)) * (v_x * B_z - v_z * B_x)
4418
4419# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4420#if defined(MFC_OpenACC)
4421# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4422!$acc loop seq
4423# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4424#elif defined(MFC_OpenMP)
4425# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4426
4427# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4428#endif
4429 do i = 0, 2
4430 flux_rsx_vf(j, k, l, &
4431 & b_idx%beg + i) = (1 - dir_flg(i + 1))*(s_m*(vel_r(dir_idx(1))*b%R(i &
4432 & + 1) - vel_r(i + 1)*b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) &
4433 & - vel_l(i + 1)*b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1))) &
4434 & /(s_m - s_p)
4435 end do
4436 end if
4437 flux_src_rsx_vf(j, k, l, advxb) = 0._wp
4438 end if
4439
4440# 1389 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4441 end do
4442 end do
4443 end do
4444
4445# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4446#if defined(MFC_OpenACC)
4447# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4448!$acc end parallel loop
4449# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4450#elif defined(MFC_OpenMP)
4451# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4452
4453# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4454!$omp end target teams loop
4455# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4456#endif
4457 end if
4458# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4459 if (norm_dir == 2) then
4460
4461# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4462
4463# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4464#if defined(MFC_OpenACC)
4465# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4466!$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)
4467# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4468#elif defined(MFC_OpenMP)
4469# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4470
4471# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4472
4473# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4474
4475# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4476!$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)
4477# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4478#endif
4479# 912 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4480 do l = is3%beg, is3%end
4481 do k = is2%beg, is2%end
4482 do j = is1%beg, is1%end
4483
4484# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4485#if defined(MFC_OpenACC)
4486# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4487!$acc loop seq
4488# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4489#elif defined(MFC_OpenMP)
4490# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4491
4492# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4493#endif
4494 do i = 1, contxe
4495 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
4496 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
4497 end do
4498
4499 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4500
4501
4502# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4503#if defined(MFC_OpenACC)
4504# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4505!$acc loop seq
4506# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4507#elif defined(MFC_OpenMP)
4508# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4509
4510# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4511#endif
4512 do i = 1, num_vels
4513 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
4514 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
4515 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4516 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4517 end do
4518
4519
4520# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4521#if defined(MFC_OpenACC)
4522# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4523!$acc loop seq
4524# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4525#elif defined(MFC_OpenMP)
4526# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4527
4528# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4529#endif
4530 do i = 1, num_fluids
4531 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
4532 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
4533 end do
4534
4535 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
4536 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
4537
4538 if (mhd) then
4539 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
4540 b%L(1) = bx0
4541 b%R(1) = bx0
4542 b%L(2) = ql_prim_rsy_vf(j, k, l, b_idx%beg)
4543 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg)
4544 b%L(3) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)
4545 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 1)
4546 else ! 2D/3D: Bx, By, Bz as variables
4547 b%L(1) = ql_prim_rsy_vf(j, k, l, b_idx%beg)
4548 b%R(1) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg)
4549 b%L(2) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)
4550 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 1)
4551 b%L(3) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 2)
4552 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 2)
4553 end if
4554 end if
4555
4556 rho_l = 0._wp
4557 gamma_l = 0._wp
4558 pi_inf_l = 0._wp
4559 qv_l = 0._wp
4560
4561 rho_r = 0._wp
4562 gamma_r = 0._wp
4563 pi_inf_r = 0._wp
4564 qv_r = 0._wp
4565
4566 alpha_l_sum = 0._wp
4567 alpha_r_sum = 0._wp
4568
4569 pres_mag%L = 0._wp
4570 pres_mag%R = 0._wp
4571
4572 if (mpp_lim) then
4573
4574# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4575#if defined(MFC_OpenACC)
4576# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4577!$acc loop seq
4578# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4579#elif defined(MFC_OpenMP)
4580# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4581
4582# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4583#endif
4584 do i = 1, num_fluids
4585 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
4586 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
4587 alpha_l_sum = alpha_l_sum + alpha_l(i)
4588 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
4589 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
4590 alpha_r_sum = alpha_r_sum + alpha_r(i)
4591 end do
4592
4593 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
4594 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
4595 end if
4596
4597
4598# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4599#if defined(MFC_OpenACC)
4600# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4601!$acc loop seq
4602# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4603#elif defined(MFC_OpenMP)
4604# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4605
4606# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4607#endif
4608 do i = 1, num_fluids
4609 rho_l = rho_l + alpha_rho_l(i)
4610 gamma_l = gamma_l + alpha_l(i)*gammas(i)
4611 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
4612 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
4613
4614 rho_r = rho_r + alpha_rho_r(i)
4615 gamma_r = gamma_r + alpha_r(i)*gammas(i)
4616 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
4617 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
4618 end do
4619
4620 if (viscous) then
4621
4622# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4623#if defined(MFC_OpenACC)
4624# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4625!$acc loop seq
4626# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4627#elif defined(MFC_OpenMP)
4628# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4629
4630# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4631#endif
4632 do i = 1, 2
4633 re_l(i) = dflt_real
4634 re_r(i) = dflt_real
4635
4636 if (re_size(i) > 0) re_l(i) = 0._wp
4637 if (re_size(i) > 0) re_r(i) = 0._wp
4638
4639
4640# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4641#if defined(MFC_OpenACC)
4642# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4643!$acc loop seq
4644# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4645#elif defined(MFC_OpenMP)
4646# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4647
4648# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4649#endif
4650 do q = 1, re_size(i)
4651 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
4652 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
4653 end do
4654
4655 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
4656 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
4657 end do
4658 end if
4659
4660 if (chemistry) then
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 i = chemxb, chemxe
4673 ys_l(i - chemxb + 1) = ql_prim_rsy_vf(j, k, l, i)
4674 ys_r(i - chemxb + 1) = qr_prim_rsy_vf(j + 1, k, l, i)
4675 end do
4676
4677 call get_mixture_molecular_weight(ys_l, mw_l)
4678 call get_mixture_molecular_weight(ys_r, mw_r)
4679
4680# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4681 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
4682 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
4683# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4684
4685 r_gas_l = gas_constant/mw_l
4686 r_gas_r = gas_constant/mw_r
4687 t_l = pres_l/rho_l/r_gas_l
4688 t_r = pres_r/rho_r/r_gas_r
4689
4690 call get_species_specific_heats_r(t_l, cp_il)
4691 call get_species_specific_heats_r(t_r, cp_ir)
4692
4693 if (chem_params%gamma_method == 1) then
4694 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
4695 gamma_il = cp_il/(cp_il - 1.0_wp)
4696 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
4697
4698 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
4699 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
4700 else if (chem_params%gamma_method == 2) then
4701 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
4702 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
4703 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
4704 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
4705 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
4706
4707 gamm_l = cp_l/cv_l
4708 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
4709 gamm_r = cp_r/cv_r
4710 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
4711 end if
4712
4713 call get_mixture_energy_mass(t_l, ys_l, e_l)
4714 call get_mixture_energy_mass(t_r, ys_r, e_r)
4715
4716 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
4717 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
4718 h_l = (e_l + pres_l)/rho_l
4719 h_r = (e_r + pres_r)/rho_r
4720 else if (mhd .and. relativity) then
4721# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4722 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
4723 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
4724 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
4725 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
4726
4727 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
4728 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
4729 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
4730 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
4731
4732 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
4733 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
4734
4735 ! Hard-coded EOS
4736 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
4737 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
4738
4739 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
4740 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
4741
4742 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
4743 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
4744# 1100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4745 else if (mhd .and. .not. relativity) then
4746 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
4747 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
4748 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
4749 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r &
4750 & + pres_mag%R ! includes magnetic energy
4751 h_l = (e_l + pres_l - pres_mag%L)/rho_l
4752 h_r = (e_r + pres_r - pres_mag%R) &
4753 & /rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
4754 else
4755 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
4756 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
4757 h_l = (e_l + pres_l)/rho_l
4758 h_r = (e_r + pres_r)/rho_r
4759 end if
4760
4761 ! elastic energy update
4762 if (hypoelasticity) then
4763 g_l = 0._wp; g_r = 0._wp
4764
4765
4766# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4767#if defined(MFC_OpenACC)
4768# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4769!$acc loop seq
4770# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4771#elif defined(MFC_OpenMP)
4772# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4773
4774# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4775#endif
4776 do i = 1, num_fluids
4777 g_l = g_l + alpha_l(i)*gs_rs(i)
4778 g_r = g_r + alpha_r(i)*gs_rs(i)
4779 end do
4780
4781 if (cont_damage) then
4782 g_l = g_l*max((1._wp - ql_prim_rsy_vf(j, k, l, damage_idx)), 0._wp)
4783 g_r = g_r*max((1._wp - qr_prim_rsy_vf(j, k, l, damage_idx)), 0._wp)
4784 end if
4785
4786 do i = 1, strxe - strxb + 1
4787 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
4788 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
4789 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
4790 if ((g_l > 1000) .and. (g_r > 1000)) then
4791 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4792 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4793 ! Double for shear stresses
4794 if (any(strxb - 1 + i == shear_indices)) then
4795 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4796 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4797 end if
4798 end if
4799 end do
4800 end if
4801
4802 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, &
4803 & qv_l)
4804
4805 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, &
4806 & qv_r)
4807
4808 if (mhd) then
4809 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
4810 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
4811 end if
4812
4813 s_l = 0._wp; s_r = 0._wp
4814
4815
4816# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4817#if defined(MFC_OpenACC)
4818# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4819!$acc loop seq
4820# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4821#elif defined(MFC_OpenMP)
4822# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4823
4824# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4825#endif
4826 do i = 1, num_dims
4827 s_l = s_l + vel_l(i)**2._wp
4828 s_r = s_r + vel_r(i)**2._wp
4829 end do
4830
4831 s_l = sqrt(s_l)
4832 s_r = sqrt(s_r)
4833
4834 s_p = max(s_l, s_r) + max(c_l, c_r)
4835 s_m = -s_p
4836
4837 s_l = s_m
4838 s_r = s_p
4839
4840 ! Low Mach correction
4841 if (low_mach == 1) then
4842 if (riemann_solver == 1 .or. riemann_solver == 5) then
4843# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4844 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4845# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4846 pcorr = 0._wp
4847# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4848
4849# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4850 if (low_mach == 1) then
4851# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4852 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4853# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4854 end if
4855# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4856 else if (riemann_solver == 2) then
4857# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4858 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4859# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4860 pcorr = 0._wp
4861# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4862
4863# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4864 if (low_mach == 1) then
4865# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4866 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))) &
4867# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4868 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
4869# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4870 else if (low_mach == 2) then
4871# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4872 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))))
4873# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4874 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))))
4875# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4876 vel_l(dir_idx(1)) = vel_l_tmp
4877# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4878 vel_r(dir_idx(1)) = vel_r_tmp
4879# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4880 end if
4881# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4882 end if
4883 else
4884 pcorr = 0._wp
4885 end if
4886
4887 ! Mass
4888 if (.not. relativity) then
4889
4890# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4891#if defined(MFC_OpenACC)
4892# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4893!$acc loop seq
4894# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4895#elif defined(MFC_OpenMP)
4896# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4897
4898# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4899#endif
4900 do i = 1, contxe
4901 flux_rsy_vf(j, k, l, &
4902 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i) &
4903 & *vel_l(norm_dir) + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
4904 end do
4905 else if (relativity) then
4906
4907# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4908#if defined(MFC_OpenACC)
4909# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4910!$acc loop seq
4911# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4912#elif defined(MFC_OpenMP)
4913# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4914
4915# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4916#endif
4917 do i = 1, contxe
4918 flux_rsy_vf(j, k, l, &
4919 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
4920 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i))) &
4921 & /(s_m - s_p)
4922 end do
4923 end if
4924
4925 ! Momentum
4926 if (mhd .and. (.not. relativity)) then
4927
4928# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4929#if defined(MFC_OpenACC)
4930# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4931!$acc loop seq
4932# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4933#elif defined(MFC_OpenMP)
4934# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4935
4936# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4937#endif
4938 do i = 1, 3
4939 ! Flux of rho*v_i in the y direction = rho * v_i * v_y - B_i * B_y +
4940 ! delta_(y,i) * p_tot
4941 flux_rsy_vf(j, k, l, &
4942 & contxe + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i)*b%R(norm_dir) &
4943 & + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
4944 & - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
4945 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
4946 end do
4947 else if (mhd .and. relativity) then
4948
4949# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4950#if defined(MFC_OpenACC)
4951# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4952!$acc loop seq
4953# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4954#elif defined(MFC_OpenMP)
4955# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4956
4957# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4958#endif
4959 do i = 1, 3
4960 ! Flux of m_i in the y direction = m_i * v_y - b_i/Gamma * B_y +
4961 ! delta_(y,i) * p_tot
4962 flux_rsy_vf(j, k, l, &
4963 & contxe + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i)/ga%R*b%R(norm_dir) &
4964 & + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i)*vel_l(norm_dir) &
4965 & - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
4966 & + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
4967 end do
4968 else if (bubbles_euler) then
4969
4970# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4971#if defined(MFC_OpenACC)
4972# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4973!$acc loop seq
4974# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4975#elif defined(MFC_OpenMP)
4976# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4977
4978# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4979#endif
4980 do i = 1, num_vels
4981 flux_rsy_vf(j, k, l, &
4982 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4983 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
4984 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
4985 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
4986 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4987 end do
4988 else if (hypoelasticity) then
4989
4990# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4991#if defined(MFC_OpenACC)
4992# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4993!$acc loop seq
4994# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4995#elif defined(MFC_OpenMP)
4996# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4997
4998# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4999#endif
5000 do i = 1, num_vels
5001 flux_rsy_vf(j, k, l, &
5002 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5003 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
5004 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
5005 & *pres_l - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5006 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
5007 end do
5008 else
5009
5010# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5011#if defined(MFC_OpenACC)
5012# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5013!$acc loop seq
5014# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5015#elif defined(MFC_OpenMP)
5016# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5017
5018# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5019#endif
5020 do i = 1, num_vels
5021 flux_rsy_vf(j, k, l, &
5022 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5023 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1)) &
5024 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l) &
5025 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
5026 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5027 end do
5028 end if
5029
5030 ! Energy
5031 if (mhd .and. (.not. relativity)) then
5032 ! energy flux = (E + p + p_mag) * v_y - B_y * (v_x*B_x + v_y*B_y + v_z*B_z)
5033# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5034 flux_rsy_vf(j, k, l, &
5035 & e_idx) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
5036 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
5037 & - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir) &
5038 & *(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) + s_m*s_p*(e_l &
5039 & - e_r))/(s_m - s_p)
5040# 1266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5041 else if (mhd .and. relativity) then
5042 ! energy flux = m_y - mass flux Hard-coded for single-component for now
5043 flux_rsy_vf(j, k, l, &
5044 & e_idx) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
5045 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l &
5046 & - e_r))/(s_m - s_p)
5047 else if (bubbles_euler) then
5048 flux_rsy_vf(j, k, l, &
5049 & e_idx) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
5050 & - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m &
5051 & - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
5052 else if (hypoelasticity) then
5053 flux_tau_l = 0._wp; flux_tau_r = 0._wp
5054
5055# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5056#if defined(MFC_OpenACC)
5057# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5058!$acc loop seq
5059# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5060#elif defined(MFC_OpenMP)
5061# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5062
5063# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5064#endif
5065 do i = 1, num_dims
5066 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
5067 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
5068 end do
5069 flux_rsy_vf(j, k, l, &
5070 & e_idx) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
5071 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r)) &
5072 & /(s_m - s_p)
5073 else
5074 flux_rsy_vf(j, k, l, &
5075 & e_idx) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
5076 & + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
5077 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
5078 end if
5079
5080 ! Elastic Stresses
5081 if (hypoelasticity) then
5082 do i = 1, strxe - strxb + 1 ! TODO: this indexing may be slow
5083 flux_rsy_vf(j, k, l, &
5084 & strxb - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
5085 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
5086 & - rho_r*tau_e_r(i)))/(s_m - s_p)
5087 end do
5088 end if
5089
5090 ! Advection flux and source: interface velocity for volume fraction transport
5091
5092# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5093#if defined(MFC_OpenACC)
5094# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5095!$acc loop seq
5096# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5097#elif defined(MFC_OpenMP)
5098# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5099
5100# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5101#endif
5102 do i = advxb, advxe
5103 flux_rsy_vf(j, k, l, i) = (ql_prim_rsy_vf(j, k, l, i) - qr_prim_rsy_vf(j + 1, &
5104 & k, l, i))*s_m*s_p/(s_m - s_p)
5105 flux_src_rsy_vf(j, k, l, i) = (s_m*qr_prim_rsy_vf(j + 1, k, l, &
5106 & i) - s_p*ql_prim_rsy_vf(j, k, l, i))/(s_m - s_p)
5107 end do
5108
5109 if (bubbles_euler) then
5110 ! From HLLC: Kills mass transport @ bubble gas density
5111 if (num_fluids > 1) then
5112 flux_rsy_vf(j, k, l, contxe) = 0._wp
5113 end if
5114 end if
5115
5116 if (chemistry) then
5117
5118# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5119#if defined(MFC_OpenACC)
5120# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5121!$acc loop seq
5122# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5123#elif defined(MFC_OpenMP)
5124# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5125
5126# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5127#endif
5128 do i = chemxb, chemxe
5129 y_l = ql_prim_rsy_vf(j, k, l, i)
5130 y_r = qr_prim_rsy_vf(j + 1, k, l, i)
5131
5132 flux_rsy_vf(j, k, l, &
5133 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
5134 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
5135 flux_src_rsy_vf(j, k, l, i) = 0._wp
5136 end do
5137 end if
5138
5139 ! MHD: magnetic flux and Maxwell stress contributions
5140 if (mhd) then
5141 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
5142 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
5143
5144# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5145#if defined(MFC_OpenACC)
5146# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5147!$acc loop seq
5148# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5149#elif defined(MFC_OpenMP)
5150# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5151
5152# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5153#endif
5154 do i = 0, 1
5155 flux_rsx_vf(j, k, l, &
5156 & b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
5157 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
5158 & - b%R(2 + i)))/(s_m - s_p)
5159 end do
5160 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
5161 ! B_x d/dy flux = (1 - delta(x,y)) * (v_y * B_x - v_x * B_y) B_y
5162 ! d/dy flux = (1 - delta(y,y)) * (v_y * B_y - v_y * B_y) B_z d/dy
5163 ! flux = (1 - delta(z,y)) * (v_y * B_z - v_z * B_y)
5164
5165# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5166#if defined(MFC_OpenACC)
5167# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5168!$acc loop seq
5169# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5170#elif defined(MFC_OpenMP)
5171# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5172
5173# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5174#endif
5175 do i = 0, 2
5176 flux_rsy_vf(j, k, l, &
5177 & b_idx%beg + i) = (1 - dir_flg(i + 1))*(s_m*(vel_r(dir_idx(1))*b%R(i &
5178 & + 1) - vel_r(i + 1)*b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) &
5179 & - vel_l(i + 1)*b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1))) &
5180 & /(s_m - s_p)
5181 end do
5182 end if
5183 flux_src_rsy_vf(j, k, l, advxb) = 0._wp
5184 end if
5185
5186# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5187 if (cyl_coord) then
5188 ! Substituting the advective flux into the inviscid geometrical source flux
5189
5190# 1364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5191#if defined(MFC_OpenACC)
5192# 1364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5193!$acc loop seq
5194# 1364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5195#elif defined(MFC_OpenMP)
5196# 1364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5197
5198# 1364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5199#endif
5200 do i = 1, e_idx
5201 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
5202 end do
5203 ! Recalculating the radial momentum geometric source flux
5204 flux_gsrc_rsy_vf(j, k, l, contxe + 2) = flux_rsy_vf(j, k, l, &
5205 & contxe + 2) - (s_m*pres_r - s_p*pres_l)/(s_m - s_p)
5206 ! Geometrical source of the void fraction(s) is zero
5207
5208# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5209#if defined(MFC_OpenACC)
5210# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5211!$acc loop seq
5212# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5213#elif defined(MFC_OpenMP)
5214# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5215
5216# 1372 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5217#endif
5218 do i = advxb, advxe
5219 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
5220 end do
5221 end if
5222
5223 if (cyl_coord .and. hypoelasticity) then
5224 ! += tau_sigmasigma using HLL
5225 flux_gsrc_rsy_vf(j, k, l, contxe + 2) = flux_gsrc_rsy_vf(j, k, l, &
5226 & contxe + 2) + (s_m*tau_e_r(4) - s_p*tau_e_l(4))/(s_m - s_p)
5227
5228
5229# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5230#if defined(MFC_OpenACC)
5231# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5232!$acc loop seq
5233# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5234#elif defined(MFC_OpenMP)
5235# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5236
5237# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5238#endif
5239 do i = strxb, strxe
5240 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
5241 end do
5242 end if
5243# 1389 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5244 end do
5245 end do
5246 end do
5247
5248# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5249#if defined(MFC_OpenACC)
5250# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5251!$acc end parallel loop
5252# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5253#elif defined(MFC_OpenMP)
5254# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5255
5256# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5257!$omp end target teams loop
5258# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5259#endif
5260 end if
5261# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5262 if (norm_dir == 3) then
5263
5264# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5265
5266# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5267#if defined(MFC_OpenACC)
5268# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5269!$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)
5270# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5271#elif defined(MFC_OpenMP)
5272# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5273
5274# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5275
5276# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5277
5278# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5279!$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)
5280# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5281#endif
5282# 912 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5283 do l = is3%beg, is3%end
5284 do k = is2%beg, is2%end
5285 do j = is1%beg, is1%end
5286
5287# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5288#if defined(MFC_OpenACC)
5289# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5290!$acc loop seq
5291# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5292#elif defined(MFC_OpenMP)
5293# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5294
5295# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5296#endif
5297 do i = 1, contxe
5298 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
5299 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
5300 end do
5301
5302 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5303
5304
5305# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5306#if defined(MFC_OpenACC)
5307# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5308!$acc loop seq
5309# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5310#elif defined(MFC_OpenMP)
5311# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5312
5313# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5314#endif
5315 do i = 1, num_vels
5316 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
5317 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
5318 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5319 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5320 end do
5321
5322
5323# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5324#if defined(MFC_OpenACC)
5325# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5326!$acc loop seq
5327# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5328#elif defined(MFC_OpenMP)
5329# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5330
5331# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5332#endif
5333 do i = 1, num_fluids
5334 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
5335 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
5336 end do
5337
5338 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
5339 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
5340
5341 if (mhd) then
5342 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
5343 b%L(1) = bx0
5344 b%R(1) = bx0
5345 b%L(2) = ql_prim_rsz_vf(j, k, l, b_idx%beg)
5346 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg)
5347 b%L(3) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)
5348 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 1)
5349 else ! 2D/3D: Bx, By, Bz as variables
5350 b%L(1) = ql_prim_rsz_vf(j, k, l, b_idx%beg)
5351 b%R(1) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg)
5352 b%L(2) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)
5353 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 1)
5354 b%L(3) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 2)
5355 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 2)
5356 end if
5357 end if
5358
5359 rho_l = 0._wp
5360 gamma_l = 0._wp
5361 pi_inf_l = 0._wp
5362 qv_l = 0._wp
5363
5364 rho_r = 0._wp
5365 gamma_r = 0._wp
5366 pi_inf_r = 0._wp
5367 qv_r = 0._wp
5368
5369 alpha_l_sum = 0._wp
5370 alpha_r_sum = 0._wp
5371
5372 pres_mag%L = 0._wp
5373 pres_mag%R = 0._wp
5374
5375 if (mpp_lim) then
5376
5377# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5378#if defined(MFC_OpenACC)
5379# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5380!$acc loop seq
5381# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5382#elif defined(MFC_OpenMP)
5383# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5384
5385# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5386#endif
5387 do i = 1, num_fluids
5388 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
5389 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
5390 alpha_l_sum = alpha_l_sum + alpha_l(i)
5391 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
5392 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
5393 alpha_r_sum = alpha_r_sum + alpha_r(i)
5394 end do
5395
5396 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
5397 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
5398 end if
5399
5400
5401# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5402#if defined(MFC_OpenACC)
5403# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5404!$acc loop seq
5405# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5406#elif defined(MFC_OpenMP)
5407# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5408
5409# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5410#endif
5411 do i = 1, num_fluids
5412 rho_l = rho_l + alpha_rho_l(i)
5413 gamma_l = gamma_l + alpha_l(i)*gammas(i)
5414 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
5415 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
5416
5417 rho_r = rho_r + alpha_rho_r(i)
5418 gamma_r = gamma_r + alpha_r(i)*gammas(i)
5419 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
5420 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
5421 end do
5422
5423 if (viscous) then
5424
5425# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5426#if defined(MFC_OpenACC)
5427# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5428!$acc loop seq
5429# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5430#elif defined(MFC_OpenMP)
5431# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5432
5433# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5434#endif
5435 do i = 1, 2
5436 re_l(i) = dflt_real
5437 re_r(i) = dflt_real
5438
5439 if (re_size(i) > 0) re_l(i) = 0._wp
5440 if (re_size(i) > 0) re_r(i) = 0._wp
5441
5442
5443# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5444#if defined(MFC_OpenACC)
5445# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5446!$acc loop seq
5447# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5448#elif defined(MFC_OpenMP)
5449# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5450
5451# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5452#endif
5453 do q = 1, re_size(i)
5454 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
5455 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
5456 end do
5457
5458 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
5459 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
5460 end do
5461 end if
5462
5463 if (chemistry) then
5464
5465# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5466#if defined(MFC_OpenACC)
5467# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5468!$acc loop seq
5469# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5470#elif defined(MFC_OpenMP)
5471# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5472
5473# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5474#endif
5475 do i = chemxb, chemxe
5476 ys_l(i - chemxb + 1) = ql_prim_rsz_vf(j, k, l, i)
5477 ys_r(i - chemxb + 1) = qr_prim_rsz_vf(j + 1, k, l, i)
5478 end do
5479
5480 call get_mixture_molecular_weight(ys_l, mw_l)
5481 call get_mixture_molecular_weight(ys_r, mw_r)
5482
5483# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5484 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
5485 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
5486# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5487
5488 r_gas_l = gas_constant/mw_l
5489 r_gas_r = gas_constant/mw_r
5490 t_l = pres_l/rho_l/r_gas_l
5491 t_r = pres_r/rho_r/r_gas_r
5492
5493 call get_species_specific_heats_r(t_l, cp_il)
5494 call get_species_specific_heats_r(t_r, cp_ir)
5495
5496 if (chem_params%gamma_method == 1) then
5497 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
5498 gamma_il = cp_il/(cp_il - 1.0_wp)
5499 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
5500
5501 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
5502 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
5503 else if (chem_params%gamma_method == 2) then
5504 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
5505 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
5506 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
5507 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
5508 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
5509
5510 gamm_l = cp_l/cv_l
5511 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
5512 gamm_r = cp_r/cv_r
5513 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
5514 end if
5515
5516 call get_mixture_energy_mass(t_l, ys_l, e_l)
5517 call get_mixture_energy_mass(t_r, ys_r, e_r)
5518
5519 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
5520 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
5521 h_l = (e_l + pres_l)/rho_l
5522 h_r = (e_r + pres_r)/rho_r
5523 else if (mhd .and. relativity) then
5524# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5525 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
5526 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
5527 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
5528 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
5529
5530 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
5531 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
5532 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
5533 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
5534
5535 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
5536 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
5537
5538 ! Hard-coded EOS
5539 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
5540 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
5541
5542 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
5543 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
5544
5545 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
5546 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
5547# 1100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5548 else if (mhd .and. .not. relativity) then
5549 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
5550 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
5551 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
5552 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r &
5553 & + pres_mag%R ! includes magnetic energy
5554 h_l = (e_l + pres_l - pres_mag%L)/rho_l
5555 h_r = (e_r + pres_r - pres_mag%R) &
5556 & /rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
5557 else
5558 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
5559 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
5560 h_l = (e_l + pres_l)/rho_l
5561 h_r = (e_r + pres_r)/rho_r
5562 end if
5563
5564 ! elastic energy update
5565 if (hypoelasticity) then
5566 g_l = 0._wp; g_r = 0._wp
5567
5568
5569# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5570#if defined(MFC_OpenACC)
5571# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5572!$acc loop seq
5573# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5574#elif defined(MFC_OpenMP)
5575# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5576
5577# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5578#endif
5579 do i = 1, num_fluids
5580 g_l = g_l + alpha_l(i)*gs_rs(i)
5581 g_r = g_r + alpha_r(i)*gs_rs(i)
5582 end do
5583
5584 if (cont_damage) then
5585 g_l = g_l*max((1._wp - ql_prim_rsz_vf(j, k, l, damage_idx)), 0._wp)
5586 g_r = g_r*max((1._wp - qr_prim_rsz_vf(j, k, l, damage_idx)), 0._wp)
5587 end if
5588
5589 do i = 1, strxe - strxb + 1
5590 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
5591 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
5592 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
5593 if ((g_l > 1000) .and. (g_r > 1000)) then
5594 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5595 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5596 ! Double for shear stresses
5597 if (any(strxb - 1 + i == shear_indices)) then
5598 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5599 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5600 end if
5601 end if
5602 end do
5603 end if
5604
5605 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, &
5606 & qv_l)
5607
5608 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, &
5609 & qv_r)
5610
5611 if (mhd) then
5612 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
5613 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
5614 end if
5615
5616 s_l = 0._wp; s_r = 0._wp
5617
5618
5619# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5620#if defined(MFC_OpenACC)
5621# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5622!$acc loop seq
5623# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5624#elif defined(MFC_OpenMP)
5625# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5626
5627# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5628#endif
5629 do i = 1, num_dims
5630 s_l = s_l + vel_l(i)**2._wp
5631 s_r = s_r + vel_r(i)**2._wp
5632 end do
5633
5634 s_l = sqrt(s_l)
5635 s_r = sqrt(s_r)
5636
5637 s_p = max(s_l, s_r) + max(c_l, c_r)
5638 s_m = -s_p
5639
5640 s_l = s_m
5641 s_r = s_p
5642
5643 ! Low Mach correction
5644 if (low_mach == 1) then
5645 if (riemann_solver == 1 .or. riemann_solver == 5) then
5646# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5647 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5648# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5649 pcorr = 0._wp
5650# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5651
5652# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5653 if (low_mach == 1) then
5654# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5655 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5656# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5657 end if
5658# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5659 else if (riemann_solver == 2) then
5660# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5661 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5662# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5663 pcorr = 0._wp
5664# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5665
5666# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5667 if (low_mach == 1) then
5668# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5669 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))) &
5670# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5671 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5672# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5673 else if (low_mach == 2) then
5674# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5675 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))))
5676# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5677 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))))
5678# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5679 vel_l(dir_idx(1)) = vel_l_tmp
5680# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5681 vel_r(dir_idx(1)) = vel_r_tmp
5682# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5683 end if
5684# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5685 end if
5686 else
5687 pcorr = 0._wp
5688 end if
5689
5690 ! Mass
5691 if (.not. relativity) then
5692
5693# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5694#if defined(MFC_OpenACC)
5695# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5696!$acc loop seq
5697# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5698#elif defined(MFC_OpenMP)
5699# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5700
5701# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5702#endif
5703 do i = 1, contxe
5704 flux_rsz_vf(j, k, l, &
5705 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i) &
5706 & *vel_l(norm_dir) + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
5707 end do
5708 else if (relativity) then
5709
5710# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5711#if defined(MFC_OpenACC)
5712# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5713!$acc loop seq
5714# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5715#elif defined(MFC_OpenMP)
5716# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5717
5718# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5719#endif
5720 do i = 1, contxe
5721 flux_rsz_vf(j, k, l, &
5722 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
5723 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i))) &
5724 & /(s_m - s_p)
5725 end do
5726 end if
5727
5728 ! Momentum
5729 if (mhd .and. (.not. relativity)) then
5730
5731# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5732#if defined(MFC_OpenACC)
5733# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5734!$acc loop seq
5735# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5736#elif defined(MFC_OpenMP)
5737# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5738
5739# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5740#endif
5741 do i = 1, 3
5742 ! Flux of rho*v_i in the z direction = rho * v_i * v_z - B_i * B_z +
5743 ! delta_(z,i) * p_tot
5744 flux_rsz_vf(j, k, l, &
5745 & contxe + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i)*b%R(norm_dir) &
5746 & + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
5747 & - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
5748 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
5749 end do
5750 else if (mhd .and. relativity) then
5751
5752# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5753#if defined(MFC_OpenACC)
5754# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5755!$acc loop seq
5756# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5757#elif defined(MFC_OpenMP)
5758# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5759
5760# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5761#endif
5762 do i = 1, 3
5763 ! Flux of m_i in the z direction = m_i * v_z - b_i/Gamma * B_z +
5764 ! delta_(z,i) * p_tot
5765 flux_rsz_vf(j, k, l, &
5766 & contxe + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i)/ga%R*b%R(norm_dir) &
5767 & + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i)*vel_l(norm_dir) &
5768 & - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
5769 & + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
5770 end do
5771 else if (bubbles_euler) then
5772
5773# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5774#if defined(MFC_OpenACC)
5775# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5776!$acc loop seq
5777# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5778#elif defined(MFC_OpenMP)
5779# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5780
5781# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5782#endif
5783 do i = 1, num_vels
5784 flux_rsz_vf(j, k, l, &
5785 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5786 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
5787 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
5788 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
5789 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5790 end do
5791 else if (hypoelasticity) then
5792
5793# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5794#if defined(MFC_OpenACC)
5795# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5796!$acc loop seq
5797# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5798#elif defined(MFC_OpenMP)
5799# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5800
5801# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5802#endif
5803 do i = 1, num_vels
5804 flux_rsz_vf(j, k, l, &
5805 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5806 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
5807 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
5808 & *pres_l - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5809 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
5810 end do
5811 else
5812
5813# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5814#if defined(MFC_OpenACC)
5815# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5816!$acc loop seq
5817# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5818#elif defined(MFC_OpenMP)
5819# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5820
5821# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5822#endif
5823 do i = 1, num_vels
5824 flux_rsz_vf(j, k, l, &
5825 & contxe + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5826 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1)) &
5827 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l) &
5828 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
5829 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5830 end do
5831 end if
5832
5833 ! Energy
5834 if (mhd .and. (.not. relativity)) then
5835 ! energy flux = (E + p + p_mag) * v_z - B_z * (v_x*B_x + v_y*B_y + v_z*B_z)
5836# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5837 flux_rsz_vf(j, k, l, &
5838 & e_idx) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
5839 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
5840 & - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir) &
5841 & *(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) + s_m*s_p*(e_l &
5842 & - e_r))/(s_m - s_p)
5843# 1266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5844 else if (mhd .and. relativity) then
5845 ! energy flux = m_z - mass flux Hard-coded for single-component for now
5846 flux_rsz_vf(j, k, l, &
5847 & e_idx) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
5848 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l &
5849 & - e_r))/(s_m - s_p)
5850 else if (bubbles_euler) then
5851 flux_rsz_vf(j, k, l, &
5852 & e_idx) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
5853 & - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m &
5854 & - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
5855 else if (hypoelasticity) then
5856 flux_tau_l = 0._wp; flux_tau_r = 0._wp
5857
5858# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5859#if defined(MFC_OpenACC)
5860# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5861!$acc loop seq
5862# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5863#elif defined(MFC_OpenMP)
5864# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5865
5866# 1279 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5867#endif
5868 do i = 1, num_dims
5869 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
5870 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
5871 end do
5872 flux_rsz_vf(j, k, l, &
5873 & e_idx) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
5874 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r)) &
5875 & /(s_m - s_p)
5876 else
5877 flux_rsz_vf(j, k, l, &
5878 & e_idx) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
5879 & + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
5880 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
5881 end if
5882
5883 ! Elastic Stresses
5884 if (hypoelasticity) then
5885 do i = 1, strxe - strxb + 1 ! TODO: this indexing may be slow
5886 flux_rsz_vf(j, k, l, &
5887 & strxb - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
5888 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
5889 & - rho_r*tau_e_r(i)))/(s_m - s_p)
5890 end do
5891 end if
5892
5893 ! Advection flux and source: interface velocity for volume fraction transport
5894
5895# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5896#if defined(MFC_OpenACC)
5897# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5898!$acc loop seq
5899# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5900#elif defined(MFC_OpenMP)
5901# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5902
5903# 1306 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5904#endif
5905 do i = advxb, advxe
5906 flux_rsz_vf(j, k, l, i) = (ql_prim_rsz_vf(j, k, l, i) - qr_prim_rsz_vf(j + 1, &
5907 & k, l, i))*s_m*s_p/(s_m - s_p)
5908 flux_src_rsz_vf(j, k, l, i) = (s_m*qr_prim_rsz_vf(j + 1, k, l, &
5909 & i) - s_p*ql_prim_rsz_vf(j, k, l, i))/(s_m - s_p)
5910 end do
5911
5912 if (bubbles_euler) then
5913 ! From HLLC: Kills mass transport @ bubble gas density
5914 if (num_fluids > 1) then
5915 flux_rsz_vf(j, k, l, contxe) = 0._wp
5916 end if
5917 end if
5918
5919 if (chemistry) then
5920
5921# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5922#if defined(MFC_OpenACC)
5923# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5924!$acc loop seq
5925# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5926#elif defined(MFC_OpenMP)
5927# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5928
5929# 1322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5930#endif
5931 do i = chemxb, chemxe
5932 y_l = ql_prim_rsz_vf(j, k, l, i)
5933 y_r = qr_prim_rsz_vf(j + 1, k, l, i)
5934
5935 flux_rsz_vf(j, k, l, &
5936 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
5937 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
5938 flux_src_rsz_vf(j, k, l, i) = 0._wp
5939 end do
5940 end if
5941
5942 ! MHD: magnetic flux and Maxwell stress contributions
5943 if (mhd) then
5944 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
5945 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
5946
5947# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5948#if defined(MFC_OpenACC)
5949# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5950!$acc loop seq
5951# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5952#elif defined(MFC_OpenMP)
5953# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5954
5955# 1338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5956#endif
5957 do i = 0, 1
5958 flux_rsx_vf(j, k, l, &
5959 & b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
5960 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
5961 & - b%R(2 + i)))/(s_m - s_p)
5962 end do
5963 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
5964 ! B_x d/dz flux = (1 - delta(x,z)) * (v_z * B_x - v_x * B_z) B_y
5965 ! d/dz flux = (1 - delta(y,z)) * (v_z * B_y - v_y * B_z) B_z d/dz
5966 ! flux = (1 - delta(z,z)) * (v_z * B_z - v_z * B_z)
5967
5968# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5969#if defined(MFC_OpenACC)
5970# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5971!$acc loop seq
5972# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5973#elif defined(MFC_OpenMP)
5974# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5975
5976# 1349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5977#endif
5978 do i = 0, 2
5979 flux_rsz_vf(j, k, l, &
5980 & b_idx%beg + i) = (1 - dir_flg(i + 1))*(s_m*(vel_r(dir_idx(1))*b%R(i &
5981 & + 1) - vel_r(i + 1)*b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) &
5982 & - vel_l(i + 1)*b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1))) &
5983 & /(s_m - s_p)
5984 end do
5985 end if
5986 flux_src_rsz_vf(j, k, l, advxb) = 0._wp
5987 end if
5988
5989# 1389 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5990 end do
5991 end do
5992 end do
5993
5994# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5995#if defined(MFC_OpenACC)
5996# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5997!$acc end parallel loop
5998# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5999#elif defined(MFC_OpenMP)
6000# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6001
6002# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6003!$omp end target teams loop
6004# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6005#endif
6006 end if
6007# 1395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6008
6009 if (viscous .or. dummy) then
6010
6011# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6012
6013# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6014#if defined(MFC_OpenACC)
6015# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6016!$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)
6017# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6018#elif defined(MFC_OpenMP)
6019# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6020
6021# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6022
6023# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6024
6025# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6026!$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)
6027# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6028#endif
6029# 1399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6030 do l = isz%beg, isz%end
6031 do k = isy%beg, isy%end
6032 do j = isx%beg, isx%end
6033 idx_right_phys(1) = j
6034 idx_right_phys(2) = k
6035 idx_right_phys(3) = l
6036 idx_right_phys(norm_dir) = idx_right_phys(norm_dir) + 1
6037
6038 if (norm_dir == 1) then
6039
6040# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6041#if defined(MFC_OpenACC)
6042# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6043!$acc loop seq
6044# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6045#elif defined(MFC_OpenMP)
6046# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6047
6048# 1408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6049#endif
6050 do i = 1, num_fluids
6051 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
6052 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
6053 end do
6054
6055
6056# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6057#if defined(MFC_OpenACC)
6058# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6059!$acc loop seq
6060# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6061#elif defined(MFC_OpenMP)
6062# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6063
6064# 1414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6065#endif
6066 do i = 1, num_dims
6067 vel_l(i) = ql_prim_rsx_vf(j, k, l, momxb + i - 1)
6068 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, momxb + i - 1)
6069 end do
6070 else if (norm_dir == 2) then
6071
6072# 1420 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6073#if defined(MFC_OpenACC)
6074# 1420 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6075!$acc loop seq
6076# 1420 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6077#elif defined(MFC_OpenMP)
6078# 1420 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6079
6080# 1420 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6081#endif
6082 do i = 1, num_fluids
6083 alpha_l(i) = ql_prim_rsy_vf(k, j, l, e_idx + i)
6084 alpha_r(i) = qr_prim_rsy_vf(k + 1, j, l, e_idx + i)
6085 end do
6086
6087# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6088#if defined(MFC_OpenACC)
6089# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6090!$acc loop seq
6091# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6092#elif defined(MFC_OpenMP)
6093# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6094
6095# 1425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6096#endif
6097 do i = 1, num_dims
6098 vel_l(i) = ql_prim_rsy_vf(k, j, l, momxb + i - 1)
6099 vel_r(i) = qr_prim_rsy_vf(k + 1, j, l, momxb + i - 1)
6100 end do
6101 else
6102
6103# 1431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6104#if defined(MFC_OpenACC)
6105# 1431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6106!$acc loop seq
6107# 1431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6108#elif defined(MFC_OpenMP)
6109# 1431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6110
6111# 1431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6112#endif
6113 do i = 1, num_fluids
6114 alpha_l(i) = ql_prim_rsz_vf(l, k, j, e_idx + i)
6115 alpha_r(i) = qr_prim_rsz_vf(l + 1, k, j, e_idx + i)
6116 end do
6117
6118
6119# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6120#if defined(MFC_OpenACC)
6121# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6122!$acc loop seq
6123# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6124#elif defined(MFC_OpenMP)
6125# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6126
6127# 1437 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6128#endif
6129 do i = 1, num_dims
6130 vel_l(i) = ql_prim_rsz_vf(l, k, j, momxb + i - 1)
6131 vel_r(i) = qr_prim_rsz_vf(l + 1, k, j, momxb + i - 1)
6132 end do
6133 end if
6134
6135
6136# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6137#if defined(MFC_OpenACC)
6138# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6139!$acc loop seq
6140# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6141#elif defined(MFC_OpenMP)
6142# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6143
6144# 1444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6145#endif
6146 do i = 1, 2
6147 re_l(i) = dflt_real
6148 re_r(i) = dflt_real
6149
6150 if (re_size(i) > 0) re_l(i) = 0._wp
6151 if (re_size(i) > 0) re_r(i) = 0._wp
6152
6153
6154# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6155#if defined(MFC_OpenACC)
6156# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6157!$acc loop seq
6158# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6159#elif defined(MFC_OpenMP)
6160# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6161
6162# 1452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6163#endif
6164 do q = 1, re_size(i)
6165 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
6166 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
6167 end do
6168
6169 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6170 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6171 end do
6172
6173 if (shear_stress) then
6174
6175# 1463 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6176#if defined(MFC_OpenACC)
6177# 1463 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6178!$acc loop seq
6179# 1463 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6180#elif defined(MFC_OpenMP)
6181# 1463 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6182
6183# 1463 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6184#endif
6185 do i = 1, num_dims
6186 vel_grad_l(i, 1) = (dql_prim_dx_vf(momxb + i - 1)%sf(j, k, l)/re_l(1))
6187 vel_grad_r(i, 1) = (dqr_prim_dx_vf(momxb + i - 1)%sf(idx_right_phys(1), idx_right_phys(2), &
6188 & idx_right_phys(3))/re_r(1))
6189# 1469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6190 if (num_dims > 1) then
6191 vel_grad_l(i, 2) = (dql_prim_dy_vf(momxb + i - 1)%sf(j, k, l)/re_l(1))
6192 vel_grad_r(i, 2) = (dqr_prim_dy_vf(momxb + i - 1)%sf(idx_right_phys(1), &
6193 & idx_right_phys(2), idx_right_phys(3))/re_r(1))
6194 end if
6195# 1475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6196 if (num_dims > 2) then
6197 vel_grad_l(i, 3) = (dql_prim_dz_vf(momxb + i - 1)%sf(j, k, l)/re_l(1))
6198 vel_grad_r(i, 3) = (dqr_prim_dz_vf(momxb + i - 1)%sf(idx_right_phys(1), &
6199 & idx_right_phys(2), idx_right_phys(3))/re_r(1))
6200 end if
6201# 1481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6202# 1482 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6203 end do
6204
6205 if (norm_dir == 1) then
6206 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, &
6207 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6208 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
6209 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(1) + vel_grad_r(1, 1)*vel_r(1))
6210# 1490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6211 if (num_dims > 1) then
6212 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, &
6213 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6214 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
6215 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(1) + vel_grad_r(2, &
6216 & 2)*vel_r(1))
6217
6218 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, &
6219 & l) - 0.5_wp*(vel_grad_l(1, 2) + vel_grad_r(1, 2)) - 0.5_wp*(vel_grad_l(2, &
6220 & 1) + vel_grad_r(2, 1))
6221 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, &
6222 & 2)*vel_l(2) + vel_grad_r(1, 2)*vel_r(2)) - 0.5_wp*(vel_grad_l(2, &
6223 & 1)*vel_l(2) + vel_grad_r(2, 1)*vel_r(2))
6224# 1504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6225 if (num_dims > 2) then
6226 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, &
6227 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6228 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
6229 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, &
6230 & 3)*vel_l(1) + vel_grad_r(3, 3)*vel_r(1))
6231
6232 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, &
6233 & l) - 0.5_wp*(vel_grad_l(1, 3) + vel_grad_r(1, &
6234 & 3)) - 0.5_wp*(vel_grad_l(3, 1) + vel_grad_r(3, 1))
6235 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
6236 & l) - 0.5_wp*(vel_grad_l(1, 3)*vel_l(3) + vel_grad_r(1, &
6237 & 3)*vel_r(3)) - 0.5_wp*(vel_grad_l(3, 1)*vel_l(3) + vel_grad_r(3, &
6238 & 1)*vel_r(3))
6239 end if
6240# 1520 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6241 end if
6242# 1522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6243 else if (norm_dir == 2) then
6244# 1524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6245 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, &
6246 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6247 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
6248 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(2) + vel_grad_r(1, 1)*vel_r(2))
6249
6250 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, &
6251 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6252 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
6253 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(2) + vel_grad_r(2, 2)*vel_r(2))
6254
6255 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, &
6256 & 2) + vel_grad_r(1, 2)) - 0.5_wp*(vel_grad_l(2, 1) + vel_grad_r(2, 1))
6257 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, &
6258 & 2)*vel_l(1) + vel_grad_r(1, 2)*vel_r(1)) - 0.5_wp*(vel_grad_l(2, &
6259 & 1)*vel_l(1) + vel_grad_r(2, 1)*vel_r(1))
6260# 1540 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6261 if (num_dims > 2) then
6262 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, &
6263 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6264 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
6265 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3)*vel_l(2) + vel_grad_r(3, &
6266 & 3)*vel_r(2))
6267
6268 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, &
6269 & l) - 0.5_wp*(vel_grad_l(2, 3) + vel_grad_r(2, &
6270 & 3)) - 0.5_wp*(vel_grad_l(3, 2) + vel_grad_r(3, 2))
6271 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
6272 & l) - 0.5_wp*(vel_grad_l(2, 3)*vel_l(3) + vel_grad_r(2, &
6273 & 3)*vel_r(3)) - 0.5_wp*(vel_grad_l(3, 2)*vel_l(3) + vel_grad_r(3, &
6274 & 2)*vel_r(3))
6275 end if
6276# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6277# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6278 else
6279# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6280 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, &
6281 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6282 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
6283 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(3) + vel_grad_r(1, 1)*vel_r(3))
6284
6285 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, &
6286 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6287 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
6288 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(3) + vel_grad_r(2, 2)*vel_r(3))
6289
6290 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, &
6291 & 3) + vel_grad_r(1, 3)) - 0.5_wp*(vel_grad_l(3, 1) + vel_grad_r(3, 1))
6292 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, &
6293 & 3)*vel_l(1) + vel_grad_r(1, 3)*vel_r(1)) - 0.5_wp*(vel_grad_l(3, &
6294 & 1)*vel_l(1) + vel_grad_r(3, 1)*vel_r(1))
6295
6296 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, &
6297 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6298 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
6299 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3)*vel_l(3) + vel_grad_r(3, 3)*vel_r(3))
6300
6301 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, &
6302 & l) - 0.5_wp*(vel_grad_l(2, 3) + vel_grad_r(2, 3)) - 0.5_wp*(vel_grad_l(3, &
6303 & 2) + vel_grad_r(3, 2))
6304 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, &
6305 & 3)*vel_l(2) + vel_grad_r(2, 3)*vel_r(2)) - 0.5_wp*(vel_grad_l(3, &
6306 & 2)*vel_l(2) + vel_grad_r(3, 2)*vel_r(2))
6307# 1587 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6308 end if
6309 end if
6310
6311 if (bulk_stress) then
6312
6313# 1591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6314#if defined(MFC_OpenACC)
6315# 1591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6316!$acc loop seq
6317# 1591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6318#elif defined(MFC_OpenMP)
6319# 1591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6320
6321# 1591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6322#endif
6323 do i = 1, num_dims
6324 vel_grad_l(i, 1) = (dql_prim_dx_vf(momxb + i - 1)%sf(j, k, l)/re_l(2))
6325 vel_grad_r(i, 1) = (dqr_prim_dx_vf(momxb + i - 1)%sf(idx_right_phys(1), idx_right_phys(2), &
6326 & idx_right_phys(3))/re_r(2))
6327# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6328 if (num_dims > 1) then
6329 vel_grad_l(i, 2) = (dql_prim_dy_vf(momxb + i - 1)%sf(j, k, l)/re_l(2))
6330 vel_grad_r(i, 2) = (dqr_prim_dy_vf(momxb + i - 1)%sf(idx_right_phys(1), &
6331 & idx_right_phys(2), idx_right_phys(3))/re_r(2))
6332 end if
6333# 1603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6334# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6335 if (num_dims > 2) then
6336 vel_grad_l(i, 3) = (dql_prim_dz_vf(momxb + i - 1)%sf(j, k, l)/re_l(2))
6337 vel_grad_r(i, 3) = (dqr_prim_dz_vf(momxb + i - 1)%sf(idx_right_phys(1), &
6338 & idx_right_phys(2), idx_right_phys(3))/re_r(2))
6339 end if
6340# 1610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6341 end do
6342
6343 if (norm_dir == 1) then
6344 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, &
6345 & 1) + vel_grad_r(1, 1))
6346 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, &
6347 & 1)*vel_l(1) + vel_grad_r(1, 1)*vel_r(1))
6348# 1618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6349 if (num_dims > 1) then
6350 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, &
6351 & 2) + vel_grad_r(2, 2))
6352 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, &
6353 & 2)*vel_l(1) + vel_grad_r(2, 2)*vel_r(1))
6354
6355# 1625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6356 if (num_dims > 2) then
6357 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, &
6358 & l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6359 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
6360 & l) - 0.5_wp*(vel_grad_l(3, 3)*vel_l(1) + vel_grad_r(3, 3)*vel_r(1))
6361 end if
6362# 1632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6363 end if
6364# 1634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6365 else if (norm_dir == 2) then
6366# 1636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6367 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, &
6368 & l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6369 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, &
6370 & 1)*vel_l(2) + vel_grad_r(1, 1)*vel_r(2))
6371
6372 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, &
6373 & l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6374 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, &
6375 & 2)*vel_l(2) + vel_grad_r(2, 2)*vel_r(2))
6376
6377# 1647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6378 if (num_dims > 2) then
6379 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, &
6380 & l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6381 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
6382 & l) - 0.5_wp*(vel_grad_l(3, 3)*vel_l(2) + vel_grad_r(3, 3)*vel_r(2))
6383 end if
6384# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6385# 1655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6386 else
6387# 1657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6388 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, &
6389 & l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6390 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, &
6391 & 1)*vel_l(3) + vel_grad_r(1, 1)*vel_r(3))
6392
6393 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, &
6394 & l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6395 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, &
6396 & 2)*vel_l(3) + vel_grad_r(2, 2)*vel_r(3))
6397
6398 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, &
6399 & l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6400 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(3, &
6401 & 3)*vel_l(3) + vel_grad_r(3, 3)*vel_r(3))
6402# 1672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6403 end if
6404 end if
6405 end do
6406 end do
6407 end do
6408
6409# 1677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6410#if defined(MFC_OpenACC)
6411# 1677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6412!$acc end parallel loop
6413# 1677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6414#elif defined(MFC_OpenMP)
6415# 1677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6416
6417# 1677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6418!$omp end target teams loop
6419# 1677 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6420#endif
6421 end if
6422
6423 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
6424
6425 end subroutine s_lf_riemann_solver
6426
6427 !> HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994)
6428 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, &
6429
6430 & 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, &
6431 & dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
6432
6433 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, ql_prim_rsy_vf, &
6434 & qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf
6435 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
6436 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
6437 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
6438 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
6439
6440 ! Intercell fluxes
6441 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
6442 integer, intent(in) :: norm_dir
6443 type(int_bounds_info), intent(in) :: ix, iy, iz
6444
6445# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6446 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
6447 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
6448 real(wp), dimension(num_dims) :: vel_l, vel_r
6449# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6450
6451 real(wp) :: rho_l, rho_r
6452 real(wp) :: pres_l, pres_r
6453 real(wp) :: e_l, e_r
6454 real(wp) :: h_l, h_r
6455# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6456 real(wp), dimension(num_species) :: ys_l, ys_r, xs_l, xs_r, gamma_il, gamma_ir, cp_il, cp_ir
6457 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
6458# 1723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6459 real(wp) :: cp_avg, cv_avg, t_avg, c_sum_yi_phi, eps
6460 real(wp) :: t_l, t_r
6461 real(wp) :: mw_l, mw_r
6462 real(wp) :: r_gas_l, r_gas_r
6463 real(wp) :: cp_l, cp_r
6464 real(wp) :: cv_l, cv_r
6465 real(wp) :: gamm_l, gamm_r
6466 real(wp) :: y_l, y_r
6467 real(wp) :: gamma_l, gamma_r
6468 real(wp) :: pi_inf_l, pi_inf_r
6469 real(wp) :: qv_l, qv_r
6470 real(wp) :: c_l, c_r
6471 real(wp), dimension(2) :: re_l, re_r
6472 real(wp) :: rho_avg
6473 real(wp) :: h_avg
6474 real(wp) :: gamma_avg
6475 real(wp) :: qv_avg
6476 real(wp) :: c_avg
6477 real(wp) :: s_l, s_r, s_m, s_p, s_s
6478 real(wp) :: xi_l, xi_r !< Left and right wave speeds functions
6479 real(wp) :: xi_m, xi_p
6480 real(wp) :: xi_mp, xi_pp
6481# 1751 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6482 real(wp), dimension(nb) :: r0_l, r0_r
6483 real(wp), dimension(nb) :: v0_l, v0_r
6484 real(wp), dimension(nb) :: p0_l, p0_r
6485 real(wp), dimension(nb) :: pbw_l, pbw_r
6486# 1756 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6487
6488 real(wp) :: alpha_l_sum, alpha_r_sum, nbub_l, nbub_r
6489 real(wp) :: ptilde_l, ptilde_r
6490 real(wp) :: pbwr3lbar, pbwr3rbar
6491 real(wp) :: r3lbar, r3rbar
6492 real(wp) :: r3v2lbar, r3v2rbar
6493 real(wp), dimension(6) :: tau_e_l, tau_e_r
6494# 1766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6495 real(wp), dimension(num_dims) :: xi_field_l, xi_field_r
6496# 1768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6497 real(wp) :: g_l, g_r
6498 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
6499 real(wp) :: vel_l_tmp, vel_r_tmp
6500 real(wp) :: rho_star, e_star, p_star, p_k_star, vel_k_star
6501 real(wp) :: pres_sl, pres_sr, ms_l, ms_r
6502 real(wp) :: flux_ene_e
6503 real(wp) :: zcoef, pcorr !< low Mach number correction
6504 integer :: re_max, i, j, k, l, q !< Generic loop iterators
6505 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
6506
6507 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
6508 & 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, &
6509 & dqr_prim_dz_vf, norm_dir, ix, iy, iz)
6510
6511 ! Reshaping inputted data based on dimensional splitting direction
6512
6513 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
6514
6515# 1787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6516 if (norm_dir == 1) then
6517 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
6518 if (model_eqns == 3) then
6519 ! 6-equation model (model_eqns=3): separate phasic internal energies
6520
6521# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6522
6523# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6524#if defined(MFC_OpenACC)
6525# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6526!$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)
6527# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6528#elif defined(MFC_OpenMP)
6529# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6530
6531# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6532
6533# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6534
6535# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6536!$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)
6537# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6538#endif
6539# 1801 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6540 do l = is3%beg, is3%end
6541 do k = is2%beg, is2%end
6542 do j = is1%beg, is1%end
6543 vel_l_rms = 0._wp; vel_r_rms = 0._wp
6544 rho_l = 0._wp; rho_r = 0._wp
6545 gamma_l = 0._wp; gamma_r = 0._wp
6546 pi_inf_l = 0._wp; pi_inf_r = 0._wp
6547 qv_l = 0._wp; qv_r = 0._wp
6548 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
6549
6550
6551# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6552#if defined(MFC_OpenACC)
6553# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6554!$acc loop seq
6555# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6556#elif defined(MFC_OpenMP)
6557# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6558
6559# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6560#endif
6561 do i = 1, num_dims
6562 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
6563 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
6564 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
6565 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
6566 end do
6567
6568 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
6569 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
6570
6571 rho_l = 0._wp
6572 gamma_l = 0._wp
6573 pi_inf_l = 0._wp
6574 qv_l = 0._wp
6575
6576 rho_r = 0._wp
6577 gamma_r = 0._wp
6578 pi_inf_r = 0._wp
6579 qv_r = 0._wp
6580
6581 alpha_l_sum = 0._wp
6582 alpha_r_sum = 0._wp
6583
6584 if (mpp_lim) then
6585
6586# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6587#if defined(MFC_OpenACC)
6588# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6589!$acc loop seq
6590# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6591#elif defined(MFC_OpenMP)
6592# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6593
6594# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6595#endif
6596 do i = 1, num_fluids
6597 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
6598 ql_prim_rsx_vf(j, k, l, e_idx + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
6599 & e_idx + i)), 1._wp)
6600 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, e_idx + i)
6601 end do
6602
6603
6604# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6605#if defined(MFC_OpenACC)
6606# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6607!$acc loop seq
6608# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6609#elif defined(MFC_OpenMP)
6610# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6611
6612# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6613#endif
6614 do i = 1, num_fluids
6615 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
6616 qr_prim_rsx_vf(j + 1, k, l, e_idx + i) = min(max(0._wp, qr_prim_rsx_vf(j + 1, &
6617 & k, l, e_idx + i)), 1._wp)
6618 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
6619 end do
6620
6621
6622# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6623#if defined(MFC_OpenACC)
6624# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6625!$acc loop seq
6626# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6627#elif defined(MFC_OpenMP)
6628# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6629
6630# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6631#endif
6632 do i = 1, num_fluids
6633 ql_prim_rsx_vf(j, k, l, e_idx + i) = ql_prim_rsx_vf(j, k, l, &
6634 & e_idx + i)/max(alpha_l_sum, sgm_eps)
6635 qr_prim_rsx_vf(j + 1, k, l, e_idx + i) = qr_prim_rsx_vf(j + 1, k, l, &
6636 & e_idx + i)/max(alpha_r_sum, sgm_eps)
6637 end do
6638 end if
6639
6640
6641# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6642#if defined(MFC_OpenACC)
6643# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6644!$acc loop seq
6645# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6646#elif defined(MFC_OpenMP)
6647# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6648
6649# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6650#endif
6651 do i = 1, num_fluids
6652 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
6653 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*gammas(i)
6654 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*pi_infs(i)
6655 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
6656
6657 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
6658 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*gammas(i)
6659 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
6660 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
6661
6662 alpha_l(i) = ql_prim_rsx_vf(j, k, l, advxb + i - 1)
6663 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, advxb + i - 1)
6664 end do
6665
6666 if (viscous) then
6667
6668# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6669#if defined(MFC_OpenACC)
6670# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6671!$acc loop seq
6672# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6673#elif defined(MFC_OpenMP)
6674# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6675
6676# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6677#endif
6678 do i = 1, 2
6679 re_l(i) = dflt_real
6680 re_r(i) = dflt_real
6681 if (re_size(i) > 0) re_l(i) = 0._wp
6682 if (re_size(i) > 0) re_r(i) = 0._wp
6683
6684# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6685#if defined(MFC_OpenACC)
6686# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6687!$acc loop seq
6688# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6689#elif defined(MFC_OpenMP)
6690# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6691
6692# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6693#endif
6694 do q = 1, re_size(i)
6695 re_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + re_idx(i, q))/res_gs(i, q) + re_l(i)
6696 re_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + re_idx(i, q))/res_gs(i, q) + re_r(i)
6697 end do
6698 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6699 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6700 end do
6701 end if
6702
6703 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
6704 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
6705
6706 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
6707 if (hypoelasticity) then
6708
6709# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6710#if defined(MFC_OpenACC)
6711# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6712!$acc loop seq
6713# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6714#elif defined(MFC_OpenMP)
6715# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6716
6717# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6718#endif
6719 do i = 1, strxe - strxb + 1
6720 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
6721 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
6722 end do
6723 g_l = 0._wp; g_r = 0._wp
6724
6725# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6726#if defined(MFC_OpenACC)
6727# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6728!$acc loop seq
6729# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6730#elif defined(MFC_OpenMP)
6731# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6732
6733# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6734#endif
6735 do i = 1, num_fluids
6736 g_l = g_l + alpha_l(i)*gs_rs(i)
6737 g_r = g_r + alpha_r(i)*gs_rs(i)
6738 end do
6739
6740# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6741#if defined(MFC_OpenACC)
6742# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6743!$acc loop seq
6744# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6745#elif defined(MFC_OpenMP)
6746# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6747
6748# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6749#endif
6750 do i = 1, strxe - strxb + 1
6751 ! Elastic contribution to energy if G large enough
6752 if ((g_l > verysmall) .and. (g_r > verysmall)) then
6753 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6754 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6755 ! Additional terms in 2D and 3D
6756 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
6757 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6758 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6759 end if
6760 end if
6761 end do
6762 end if
6763
6764 ! Hyperelastic stress contribution: strain energy added to total energy
6765 if (hyperelasticity) then
6766
6767# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6768#if defined(MFC_OpenACC)
6769# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6770!$acc loop seq
6771# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6772#elif defined(MFC_OpenMP)
6773# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6774
6775# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6776#endif
6777 do i = 1, num_dims
6778 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, xibeg - 1 + i)
6779 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, xibeg - 1 + i)
6780 end do
6781 g_l = 0._wp; g_r = 0._wp
6782
6783# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6784#if defined(MFC_OpenACC)
6785# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6786!$acc loop seq
6787# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6788#elif defined(MFC_OpenMP)
6789# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6790
6791# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6792#endif
6793 do i = 1, num_fluids
6794 ! Mixture left and right shear modulus
6795 g_l = g_l + alpha_l(i)*gs_rs(i)
6796 g_r = g_r + alpha_r(i)*gs_rs(i)
6797 end do
6798 ! Elastic contribution to energy if G large enough
6799 if (g_l > verysmall .and. g_r > verysmall) then
6800 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, xiend + 1)
6801 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, xiend + 1)
6802 end if
6803
6804# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6805#if defined(MFC_OpenACC)
6806# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6807!$acc loop seq
6808# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6809#elif defined(MFC_OpenMP)
6810# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6811
6812# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6813#endif
6814 do i = 1, b_size - 1
6815 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
6816 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
6817 end do
6818 end if
6819
6820 h_l = (e_l + pres_l)/rho_l
6821 h_r = (e_r + pres_r)/rho_r
6822
6823 if (avg_state == 1) then
6824# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6825 rho_avg = sqrt(rho_l*rho_r)
6826# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6827
6828# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6829 vel_avg_rms = 0._wp
6830# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6831
6832# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6833
6834# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6835#if defined(MFC_OpenACC)
6836# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6837!$acc loop seq
6838# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6839#elif defined(MFC_OpenMP)
6840# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6841
6842# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6843#endif
6844# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6845 do i = 1, num_vels
6846# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6847 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
6848# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6849 end do
6850# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6851
6852# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6853 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
6854# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6855
6856# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6857 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
6858# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6859
6860# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6861 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
6862# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6863
6864# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6865 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
6866# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6867
6868# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6869 if (chemistry) then
6870# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6871 eps = 0.001_wp
6872# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6873 call get_species_enthalpies_rt(t_l, h_il)
6874# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6875 call get_species_enthalpies_rt(t_r, h_ir)
6876# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6877 h_il = h_il*gas_constant/molecular_weights*t_l
6878# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6879 h_ir = h_ir*gas_constant/molecular_weights*t_r
6880# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6881 call get_species_specific_heats_r(t_l, cp_il)
6882# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6883 call get_species_specific_heats_r(t_r, cp_ir)
6884# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6885
6886# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6887 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
6888# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6889 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
6890# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6891 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
6892# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6893 if (abs(t_l - t_r) < eps) then
6894# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6895 ! Case when T_L and T_R are very close
6896# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6897 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
6898# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6899 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
6900# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6901 & - gas_constant/molecular_weights(:)))
6902# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6903 else
6904# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6905 ! Normal calculation when T_L and T_R are sufficiently different
6906# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6907 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
6908# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6909 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
6910# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6911 end if
6912# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6913 gamma_avg = cp_avg/cv_avg
6914# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6915
6916# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6917 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
6918# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6919 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
6920# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6921 end if
6922# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6923 end if
6924# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6925
6926# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6927 if (avg_state == 2) then
6928# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6929 rho_avg = 5.e-1_wp*(rho_l + rho_r)
6930# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6931 vel_avg_rms = 0._wp
6932# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6933
6934# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6935#if defined(MFC_OpenACC)
6936# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6937!$acc loop seq
6938# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6939#elif defined(MFC_OpenMP)
6940# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6941
6942# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6943#endif
6944# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6945 do i = 1, num_vels
6946# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6947 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
6948# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6949 end do
6950# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6951
6952# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6953 h_avg = 5.e-1_wp*(h_l + h_r)
6954# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6955 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
6956# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6957 qv_avg = 5.e-1_wp*(qv_l + qv_r)
6958# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6959 end if
6960
6961 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
6962 & c_l, qv_l)
6963
6964 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
6965 & c_r, qv_r)
6966
6967 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
6968 ! variables are placeholders to call the subroutine.
6969 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
6970 & 0._wp, c_avg, qv_avg)
6971
6972 if (viscous) then
6973
6974# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6975#if defined(MFC_OpenACC)
6976# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6977!$acc loop seq
6978# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6979#elif defined(MFC_OpenMP)
6980# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6981
6982# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6983#endif
6984 do i = 1, 2
6985 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
6986 end do
6987 end if
6988
6989 ! Low Mach correction
6990 if (low_mach == 2) then
6991 if (riemann_solver == 1 .or. riemann_solver == 5) then
6992# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6993 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6994# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6995 pcorr = 0._wp
6996# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6997
6998# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6999 if (low_mach == 1) then
7000# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7001 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7002# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7003 end if
7004# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7005 else if (riemann_solver == 2) then
7006# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7007 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7008# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7009 pcorr = 0._wp
7010# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7011
7012# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7013 if (low_mach == 1) then
7014# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7015 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))) &
7016# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7017 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7018# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7019 else if (low_mach == 2) then
7020# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7021 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))))
7022# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7023 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))))
7024# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7025 vel_l(dir_idx(1)) = vel_l_tmp
7026# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7027 vel_r(dir_idx(1)) = vel_r_tmp
7028# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7029 end if
7030# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7031 end if
7032 end if
7033
7034 ! COMPUTING THE DIRECT WAVE SPEEDS
7035 if (wave_speeds == 1) then
7036 if (elasticity) then
7037 ! Elastic wave speed, Rodriguez et al. JCP (2019)
7038 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) &
7039 & ))/rho_l), &
7040 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
7041 & + tau_e_r(dir_idx_tau(1)))/rho_r))
7042 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) &
7043 & ))/rho_r), &
7044 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
7045 & + tau_e_l(dir_idx_tau(1)))/rho_l))
7046 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
7047 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
7048 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
7049 & - vel_r(dir_idx(1))))
7050 else
7051 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7052 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7053 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7054 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
7055 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
7056 end if
7057 else if (wave_speeds == 2) then
7058 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7059
7060 pres_sr = pres_sl
7061
7062 ! Low Mach correction: Thornber et al. JCP (2008)
7063 ms_l = max(1._wp, &
7064 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
7065 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7066 ms_r = max(1._wp, &
7067 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
7068 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7069
7070 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7071 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7072
7073 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7074 end if
7075
7076 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7077 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7078
7079 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7080 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
7081 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
7082
7083 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7084 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
7085 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
7086
7087 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
7088 xi_mp = -min(0._wp, sign(1._wp, s_l))
7089 xi_pp = max(0._wp, sign(1._wp, s_r))
7090
7091 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 &
7092 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
7093 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
7094 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
7095 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
7096
7097 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))
7098
7099 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 &
7100 & - vel_r(dir_idx(1)))
7101
7102 ! Low Mach correction
7103 if (low_mach == 1) then
7104 if (riemann_solver == 1 .or. riemann_solver == 5) then
7105# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7106 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7107# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7108 pcorr = 0._wp
7109# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7110
7111# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7112 if (low_mach == 1) then
7113# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7114 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7115# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7116 end if
7117# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7118 else if (riemann_solver == 2) then
7119# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7120 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7121# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7122 pcorr = 0._wp
7123# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7124
7125# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7126 if (low_mach == 1) then
7127# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7128 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))) &
7129# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7130 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7131# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7132 else if (low_mach == 2) then
7133# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7134 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))))
7135# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7136 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))))
7137# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7138 vel_l(dir_idx(1)) = vel_l_tmp
7139# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7140 vel_r(dir_idx(1)) = vel_r_tmp
7141# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7142 end if
7143# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7144 end if
7145 else
7146 pcorr = 0._wp
7147 end if
7148
7149 ! COMPUTING FLUXES MASS FLUX.
7150
7151# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7152#if defined(MFC_OpenACC)
7153# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7154!$acc loop seq
7155# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7156#elif defined(MFC_OpenMP)
7157# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7158
7159# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7160#endif
7161 do i = 1, contxe
7162 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7163 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsx_vf(j &
7164 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7165 end do
7166
7167 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7168
7169# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7170#if defined(MFC_OpenACC)
7171# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7172!$acc loop seq
7173# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7174#elif defined(MFC_OpenMP)
7175# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7176
7177# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7178#endif
7179 do i = 1, num_dims
7180 flux_rsx_vf(j, k, l, &
7181 & contxe + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
7182 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
7183 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l) &
7184 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
7185 end do
7186
7187 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
7188 flux_rsx_vf(j, k, l, e_idx) = (e_star + p_star)*vel_k_star + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
7189
7190 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
7191 if (elasticity) then
7192 flux_ene_e = 0._wp
7193
7194# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7195#if defined(MFC_OpenACC)
7196# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7197!$acc loop seq
7198# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7199#elif defined(MFC_OpenMP)
7200# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7201
7202# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7203#endif
7204 do i = 1, num_dims
7205 ! MOMENTUM ELASTIC FLUX.
7206 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = flux_rsx_vf(j, k, l, &
7207 & contxe + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
7208 & - xi_p*tau_e_r(dir_idx_tau(i))
7209 ! ENERGY ELASTIC FLUX.
7210 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
7211 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
7212 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
7213 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
7214 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
7215 end do
7216 flux_rsx_vf(j, k, l, e_idx) = flux_rsx_vf(j, k, l, e_idx) + flux_ene_e
7217 end if
7218
7219 ! VOLUME FRACTION FLUX.
7220
7221# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7222#if defined(MFC_OpenACC)
7223# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7224!$acc loop seq
7225# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7226#elif defined(MFC_OpenMP)
7227# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7228
7229# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7230#endif
7231 do i = advxb, advxe
7232 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7233 & i)*s_s + xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*s_s
7234 end do
7235
7236 ! Advection velocity source: interface velocity for volume fraction transport
7237
7238# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7239#if defined(MFC_OpenACC)
7240# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7241!$acc loop seq
7242# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7243#elif defined(MFC_OpenMP)
7244# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7245
7246# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7247#endif
7248 do i = 1, num_dims
7249 vel_src_rsx_vf(j, k, l, &
7250 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
7251 & *(s_s*(xi_mp*(xi_l - 1) + 1) - vel_l(dir_idx(i)))) &
7252 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(s_s*(xi_pp*(xi_r - 1) &
7253 & + 1) - vel_r(dir_idx(i))))
7254 end do
7255
7256 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
7257 ! energy flux
7258
7259# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7260#if defined(MFC_OpenACC)
7261# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7262!$acc loop seq
7263# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7264#elif defined(MFC_OpenMP)
7265# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7266
7267# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7268#endif
7269 do i = 1, num_fluids
7270 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
7271 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
7272 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
7273 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
7274 & + pres_r)
7275
7276 flux_rsx_vf(j, k, l, i + intxb - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
7277 & i + advxb - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7278 & i + advxb - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
7279 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
7280 & i + contxb - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7281 & i + contxb - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
7282 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
7283 & i + advxb - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, i + advxb - 1))
7284 end do
7285
7286 flux_src_rsx_vf(j, k, l, advxb) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7287
7288 ! HYPOELASTIC STRESS EVOLUTION FLUX.
7289 if (hypoelasticity) then
7290
7291# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7292#if defined(MFC_OpenACC)
7293# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7294!$acc loop seq
7295# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7296#elif defined(MFC_OpenMP)
7297# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7298
7299# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7300#endif
7301 do i = 1, strxe - strxb + 1
7302 flux_rsx_vf(j, k, l, &
7303 & strxb - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
7304 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
7305 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
7306 end do
7307 end if
7308
7309 ! Hyperelastic reference map flux for material deformation tracking
7310 if (hyperelasticity) then
7311
7312# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7313#if defined(MFC_OpenACC)
7314# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7315!$acc loop seq
7316# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7317#elif defined(MFC_OpenMP)
7318# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7319
7320# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7321#endif
7322 do i = 1, num_dims
7323 flux_rsx_vf(j, k, l, &
7324 & xibeg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
7325 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
7326 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
7327 end do
7328 end if
7329
7330 ! COLOR FUNCTION FLUX
7331 if (surface_tension) then
7332 flux_rsx_vf(j, k, l, c_idx) = (xi_m*ql_prim_rsx_vf(j, k, l, &
7333 & c_idx) + xi_p*qr_prim_rsx_vf(j + 1, k, l, c_idx))*s_s
7334 end if
7335
7336 ! Geometrical source flux for cylindrical coordinates
7337# 2183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7338# 2195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7339 end do
7340 end do
7341 end do
7342
7343# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7344#if defined(MFC_OpenACC)
7345# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7346!$acc end parallel loop
7347# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7348#elif defined(MFC_OpenMP)
7349# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7350
7351# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7352!$omp end target teams loop
7353# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7354#endif
7355 else if (model_eqns == 4) then
7356 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
7357
7358# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7359
7360# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7361#if defined(MFC_OpenACC)
7362# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7363!$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)
7364# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7365#elif defined(MFC_OpenMP)
7366# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7367
7368# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7369
7370# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7371
7372# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7373!$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)
7374# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7375#endif
7376# 2210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7377 do l = is3%beg, is3%end
7378 do k = is2%beg, is2%end
7379 do j = is1%beg, is1%end
7380 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7381 rho_l = 0._wp; rho_r = 0._wp
7382 gamma_l = 0._wp; gamma_r = 0._wp
7383 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7384 qv_l = 0._wp; qv_r = 0._wp
7385
7386
7387# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7388#if defined(MFC_OpenACC)
7389# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7390!$acc loop seq
7391# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7392#elif defined(MFC_OpenMP)
7393# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7394
7395# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7396#endif
7397 do i = 1, contxe
7398 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
7399 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
7400 end do
7401
7402
7403# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7404#if defined(MFC_OpenACC)
7405# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7406!$acc loop seq
7407# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7408#elif defined(MFC_OpenMP)
7409# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7410
7411# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7412#endif
7413 do i = 1, num_dims
7414 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
7415 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
7416 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7417 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7418 end do
7419
7420
7421# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7422#if defined(MFC_OpenACC)
7423# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7424!$acc loop seq
7425# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7426#elif defined(MFC_OpenMP)
7427# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7428
7429# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7430#endif
7431 do i = 1, num_fluids
7432 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
7433 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
7434 end do
7435
7436# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7437#if defined(MFC_OpenACC)
7438# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7439!$acc loop seq
7440# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7441#elif defined(MFC_OpenMP)
7442# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7443
7444# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7445#endif
7446 do i = 1, num_fluids
7447 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
7448 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
7449 end do
7450
7451
7452# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7453#if defined(MFC_OpenACC)
7454# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7455!$acc loop seq
7456# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7457#elif defined(MFC_OpenMP)
7458# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7459
7460# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7461#endif
7462 do i = 1, num_fluids
7463 rho_l = rho_l + alpha_rho_l(i)
7464 gamma_l = gamma_l + alpha_l(i)*gammas(i)
7465 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
7466 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
7467
7468 rho_r = rho_r + alpha_rho_r(i)
7469 gamma_r = gamma_r + alpha_r(i)*gammas(i)
7470 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
7471 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
7472 end do
7473
7474 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
7475 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
7476
7477 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
7478 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
7479
7480 h_l = (e_l + pres_l)/rho_l
7481 h_r = (e_r + pres_r)/rho_r
7482
7483 if (avg_state == 1) then
7484# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7485 rho_avg = sqrt(rho_l*rho_r)
7486# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7487
7488# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7489 vel_avg_rms = 0._wp
7490# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7491
7492# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7493
7494# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7495#if defined(MFC_OpenACC)
7496# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7497!$acc loop seq
7498# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7499#elif defined(MFC_OpenMP)
7500# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7501
7502# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7503#endif
7504# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7505 do i = 1, num_vels
7506# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7507 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
7508# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7509 end do
7510# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7511
7512# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7513 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
7514# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7515
7516# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7517 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
7518# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7519
7520# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7521 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
7522# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7523
7524# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7525 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
7526# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7527
7528# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7529 if (chemistry) then
7530# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7531 eps = 0.001_wp
7532# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7533 call get_species_enthalpies_rt(t_l, h_il)
7534# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7535 call get_species_enthalpies_rt(t_r, h_ir)
7536# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7537 h_il = h_il*gas_constant/molecular_weights*t_l
7538# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7539 h_ir = h_ir*gas_constant/molecular_weights*t_r
7540# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7541 call get_species_specific_heats_r(t_l, cp_il)
7542# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7543 call get_species_specific_heats_r(t_r, cp_ir)
7544# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7545
7546# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7547 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
7548# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7549 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
7550# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7551 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
7552# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7553 if (abs(t_l - t_r) < eps) then
7554# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7555 ! Case when T_L and T_R are very close
7556# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7557 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
7558# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7559 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
7560# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7561 & - gas_constant/molecular_weights(:)))
7562# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7563 else
7564# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7565 ! Normal calculation when T_L and T_R are sufficiently different
7566# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7567 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
7568# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7569 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
7570# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7571 end if
7572# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7573 gamma_avg = cp_avg/cv_avg
7574# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7575
7576# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7577 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
7578# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7579 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
7580# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7581 end if
7582# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7583 end if
7584# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7585
7586# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7587 if (avg_state == 2) then
7588# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7589 rho_avg = 5.e-1_wp*(rho_l + rho_r)
7590# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7591 vel_avg_rms = 0._wp
7592# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7593
7594# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7595#if defined(MFC_OpenACC)
7596# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7597!$acc loop seq
7598# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7599#elif defined(MFC_OpenMP)
7600# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7601
7602# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7603#endif
7604# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7605 do i = 1, num_vels
7606# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7607 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
7608# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7609 end do
7610# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7611
7612# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7613 h_avg = 5.e-1_wp*(h_l + h_r)
7614# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7615 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
7616# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7617 qv_avg = 5.e-1_wp*(qv_l + qv_r)
7618# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7619 end if
7620
7621 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
7622 & c_l, qv_l)
7623
7624 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
7625 & c_r, qv_r)
7626
7627 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
7628 ! variables are placeholders to call the subroutine.
7629
7630 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
7631 & 0._wp, c_avg, qv_avg)
7632
7633 if (wave_speeds == 1) then
7634 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7635 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7636
7637 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7638 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
7639 & - rho_r*(s_r - vel_r(dir_idx(1))))
7640 else if (wave_speeds == 2) then
7641 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7642
7643 pres_sr = pres_sl
7644
7645 ! Low Mach correction: Thornber et al. JCP (2008)
7646 ms_l = max(1._wp, &
7647 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
7648 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7649 ms_r = max(1._wp, &
7650 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
7651 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7652
7653 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7654 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7655
7656 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7657 end if
7658
7659 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7660 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7661
7662 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7663 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
7664 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
7665
7666 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7667 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
7668 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
7669
7670
7671# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7672#if defined(MFC_OpenACC)
7673# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7674!$acc loop seq
7675# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7676#elif defined(MFC_OpenMP)
7677# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7678
7679# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7680#endif
7681 do i = 1, contxe
7682 flux_rsx_vf(j, k, l, &
7683 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
7684 & + xi_p*alpha_rho_r(i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7685 end do
7686
7687 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7688
7689# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7690#if defined(MFC_OpenACC)
7691# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7692!$acc loop seq
7693# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7694#elif defined(MFC_OpenMP)
7695# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7696
7697# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7698#endif
7699 do i = 1, num_dims
7700 flux_rsx_vf(j, k, l, &
7701 & contxe + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
7702 & + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7703 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
7704 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
7705 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7706 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
7707 end do
7708
7709 if (bubbles_euler) then
7710 ! Put p_tilde in
7711
7712# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7713#if defined(MFC_OpenACC)
7714# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7715!$acc loop seq
7716# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7717#elif defined(MFC_OpenMP)
7718# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7719
7720# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7721#endif
7722 do i = 1, num_dims
7723 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = flux_rsx_vf(j, k, l, &
7724 & contxe + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l)) &
7725 & + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
7726 end do
7727 end if
7728
7729 flux_rsx_vf(j, k, l, e_idx) = 0._wp
7730
7731
7732# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7733#if defined(MFC_OpenACC)
7734# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7735!$acc loop seq
7736# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7737#elif defined(MFC_OpenMP)
7738# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7739
7740# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7741#endif
7742 do i = alf_idx, alf_idx ! only advect the void fraction
7743 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7744 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsx_vf(j &
7745 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7746 end do
7747
7748 ! Advection velocity source: interface velocity for volume fraction transport
7749
7750# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7751#if defined(MFC_OpenACC)
7752# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7753!$acc loop seq
7754# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7755#elif defined(MFC_OpenMP)
7756# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7757
7758# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7759#endif
7760 do i = 1, num_dims
7761 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
7762 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
7763 end do
7764
7765 flux_src_rsx_vf(j, k, l, advxb) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7766
7767 ! Add advection flux for bubble variables
7768 if (bubbles_euler) then
7769
7770# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7771#if defined(MFC_OpenACC)
7772# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7773!$acc loop seq
7774# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7775#elif defined(MFC_OpenMP)
7776# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7777
7778# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7779#endif
7780 do i = bubxb, bubxe
7781 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
7782 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
7783 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, &
7784 & i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7785 end do
7786 end if
7787
7788 ! Geometrical source flux for cylindrical coordinates
7789
7790# 2399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7791# 2415 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7792 end do
7793 end do
7794 end do
7795
7796# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7797#if defined(MFC_OpenACC)
7798# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7799!$acc end parallel loop
7800# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7801#elif defined(MFC_OpenMP)
7802# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7803
7804# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7805!$omp end target teams loop
7806# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7807#endif
7808 else if (model_eqns == 2 .and. bubbles_euler) then
7809 ! 5-equation model with Euler-Euler bubble dynamics
7810
7811# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7812
7813# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7814#if defined(MFC_OpenACC)
7815# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7816!$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)
7817# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7818#elif defined(MFC_OpenMP)
7819# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7820
7821# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7822
7823# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7824
7825# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7826!$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)
7827# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7828#endif
7829# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7830 do l = is3%beg, is3%end
7831 do k = is2%beg, is2%end
7832 do j = is1%beg, is1%end
7833 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7834 rho_l = 0._wp; rho_r = 0._wp
7835 gamma_l = 0._wp; gamma_r = 0._wp
7836 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7837 qv_l = 0._wp; qv_r = 0._wp
7838
7839
7840# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7841#if defined(MFC_OpenACC)
7842# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7843!$acc loop seq
7844# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7845#elif defined(MFC_OpenMP)
7846# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7847
7848# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7849#endif
7850 do i = 1, num_fluids
7851 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
7852 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
7853 end do
7854
7855 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7856
7857
7858# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7859#if defined(MFC_OpenACC)
7860# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7861!$acc loop seq
7862# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7863#elif defined(MFC_OpenMP)
7864# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7865
7866# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7867#endif
7868 do i = 1, num_dims
7869 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
7870 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
7871 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7872 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7873 end do
7874
7875 ! Retain this in the refactor
7876 if (mpp_lim .and. (num_fluids > 2)) then
7877
7878# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7879#if defined(MFC_OpenACC)
7880# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7881!$acc loop seq
7882# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7883#elif defined(MFC_OpenMP)
7884# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7885
7886# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7887#endif
7888 do i = 1, num_fluids
7889 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7890 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*gammas(i)
7891 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*pi_infs(i)
7892 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7893 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
7894 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*gammas(i)
7895 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
7896 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
7897 end do
7898 else if (num_fluids > 2) then
7899
7900# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7901#if defined(MFC_OpenACC)
7902# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7903!$acc loop seq
7904# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7905#elif defined(MFC_OpenMP)
7906# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7907
7908# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7909#endif
7910 do i = 1, num_fluids - 1
7911 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7912 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*gammas(i)
7913 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*pi_infs(i)
7914 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7915 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
7916 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*gammas(i)
7917 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
7918 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
7919 end do
7920 else
7921 rho_l = ql_prim_rsx_vf(j, k, l, 1)
7922 gamma_l = gammas(1)
7923 pi_inf_l = pi_infs(1)
7924 qv_l = qvs(1)
7925 rho_r = qr_prim_rsx_vf(j + 1, k, l, 1)
7926 gamma_r = gammas(1)
7927 pi_inf_r = pi_infs(1)
7928 qv_r = qvs(1)
7929 end if
7930
7931 if (viscous) then
7932 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
7933
7934# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7935#if defined(MFC_OpenACC)
7936# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7937!$acc loop seq
7938# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7939#elif defined(MFC_OpenMP)
7940# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7941
7942# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7943#endif
7944 do i = 1, 2
7945 re_l(i) = dflt_real
7946 re_r(i) = dflt_real
7947
7948 if (re_size(i) > 0) re_l(i) = 0._wp
7949 if (re_size(i) > 0) re_r(i) = 0._wp
7950
7951
7952# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7953#if defined(MFC_OpenACC)
7954# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7955!$acc loop seq
7956# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7957#elif defined(MFC_OpenMP)
7958# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7959
7960# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7961#endif
7962 do q = 1, re_size(i)
7963 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, e_idx + re_idx(i, q)))/res_gs(i, &
7964 & q) + re_l(i)
7965 re_r(i) = (1._wp - qr_prim_rsx_vf(j + 1, k, l, e_idx + re_idx(i, &
7966 & q)))/res_gs(i, q) + re_r(i)
7967 end do
7968
7969 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
7970 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
7971 end do
7972 end if
7973 end if
7974
7975 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
7976 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
7977
7978 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
7979 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
7980
7981 h_l = (e_l + pres_l)/rho_l
7982 h_r = (e_r + pres_r)/rho_r
7983
7984 if (avg_state == 2) then
7985
7986# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7987#if defined(MFC_OpenACC)
7988# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7989!$acc loop seq
7990# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7991#elif defined(MFC_OpenMP)
7992# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7993
7994# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7995#endif
7996 do i = 1, nb
7997 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
7998 r0_r(i) = qr_prim_rsx_vf(j + 1, k, l, rs(i))
7999
8000 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
8001 v0_r(i) = qr_prim_rsx_vf(j + 1, k, l, vs(i))
8002 if (.not. polytropic .and. .not. qbmm) then
8003 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
8004 p0_r(i) = qr_prim_rsx_vf(j + 1, k, l, ps(i))
8005 end if
8006 end do
8007
8008 if (.not. qbmm) then
8009 if (adv_n) then
8010 nbub_l = ql_prim_rsx_vf(j, k, l, n_idx)
8011 nbub_r = qr_prim_rsx_vf(j + 1, k, l, n_idx)
8012 else
8013 nbub_l = 0._wp
8014 nbub_r = 0._wp
8015
8016# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8017#if defined(MFC_OpenACC)
8018# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8019!$acc loop seq
8020# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8021#elif defined(MFC_OpenMP)
8022# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8023
8024# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8025#endif
8026 do i = 1, nb
8027 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
8028 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
8029 end do
8030
8031 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, e_idx + num_fluids)/nbub_l
8032 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j + 1, k, l, e_idx + num_fluids)/nbub_r
8033 end if
8034 else
8035 ! nb stored in 0th moment of first R0 bin in variable conversion module
8036 nbub_l = ql_prim_rsx_vf(j, k, l, bubxb)
8037 nbub_r = qr_prim_rsx_vf(j + 1, k, l, bubxb)
8038 end if
8039
8040
8041# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8042#if defined(MFC_OpenACC)
8043# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8044!$acc loop seq
8045# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8046#elif defined(MFC_OpenMP)
8047# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8048
8049# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8050#endif
8051 do i = 1, nb
8052 if (.not. qbmm) then
8053 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
8054 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
8055 end if
8056 end do
8057
8058 if (qbmm) then
8059 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
8060 pbwr3rbar = mom_sp_rsx_vf(j + 1, k, l, 4)
8061
8062 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
8063 r3rbar = mom_sp_rsx_vf(j + 1, k, l, 1)
8064
8065 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
8066 r3v2rbar = mom_sp_rsx_vf(j + 1, k, l, 3)
8067 else
8068 pbwr3lbar = 0._wp
8069 pbwr3rbar = 0._wp
8070
8071 r3lbar = 0._wp
8072 r3rbar = 0._wp
8073
8074 r3v2lbar = 0._wp
8075 r3v2rbar = 0._wp
8076
8077
8078# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8079#if defined(MFC_OpenACC)
8080# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8081!$acc loop seq
8082# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8083#elif defined(MFC_OpenMP)
8084# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8085
8086# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8087#endif
8088 do i = 1, nb
8089 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
8090 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
8091
8092 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
8093 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
8094
8095 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
8096 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
8097 end do
8098 end if
8099
8100 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8101 h_avg = 5.e-1_wp*(h_l + h_r)
8102 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8103 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8104 vel_avg_rms = 0._wp
8105
8106
8107# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8108#if defined(MFC_OpenACC)
8109# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8110!$acc loop seq
8111# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8112#elif defined(MFC_OpenMP)
8113# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8114
8115# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8116#endif
8117 do i = 1, num_dims
8118 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8119 end do
8120 end if
8121
8122 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
8123 & c_l, qv_l)
8124
8125 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
8126 & c_r, qv_r)
8127
8128 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8129 ! variables are placeholders to call the subroutine.
8130 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
8131 & 0._wp, c_avg, qv_avg)
8132
8133 if (viscous) then
8134
8135# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8136#if defined(MFC_OpenACC)
8137# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8138!$acc loop seq
8139# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8140#elif defined(MFC_OpenMP)
8141# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8142
8143# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8144#endif
8145 do i = 1, 2
8146 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
8147 end do
8148 end if
8149
8150 ! Low Mach correction
8151 if (low_mach == 2) then
8152 if (riemann_solver == 1 .or. riemann_solver == 5) then
8153# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8154 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8155# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8156 pcorr = 0._wp
8157# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8158
8159# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8160 if (low_mach == 1) then
8161# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8162 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8163# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8164 end if
8165# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8166 else if (riemann_solver == 2) then
8167# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8168 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8169# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8170 pcorr = 0._wp
8171# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8172
8173# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8174 if (low_mach == 1) then
8175# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8176 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))) &
8177# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8178 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8179# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8180 else if (low_mach == 2) then
8181# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8182 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))))
8183# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8184 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))))
8185# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8186 vel_l(dir_idx(1)) = vel_l_tmp
8187# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8188 vel_r(dir_idx(1)) = vel_r_tmp
8189# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8190 end if
8191# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8192 end if
8193 end if
8194
8195 if (wave_speeds == 1) then
8196 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
8197 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
8198
8199 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
8200 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
8201 & - rho_r*(s_r - vel_r(dir_idx(1))))
8202 else if (wave_speeds == 2) then
8203 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8204
8205 pres_sr = pres_sl
8206
8207 ! Low Mach correction: Thornber et al. JCP (2008)
8208 ms_l = max(1._wp, &
8209 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
8210 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
8211 ms_r = max(1._wp, &
8212 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
8213 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
8214
8215 s_l = vel_l(dir_idx(1)) - c_l*ms_l
8216 s_r = vel_r(dir_idx(1)) + c_r*ms_r
8217
8218 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
8219 end if
8220
8221 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
8222 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
8223
8224 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
8225 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
8226 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
8227
8228 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
8229 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
8230 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
8231
8232 ! Low Mach correction
8233 if (low_mach == 1) then
8234 if (riemann_solver == 1 .or. riemann_solver == 5) then
8235# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8236 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8237# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8238 pcorr = 0._wp
8239# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8240
8241# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8242 if (low_mach == 1) then
8243# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8244 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8245# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8246 end if
8247# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8248 else if (riemann_solver == 2) then
8249# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8250 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8251# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8252 pcorr = 0._wp
8253# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8254
8255# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8256 if (low_mach == 1) then
8257# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8258 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))) &
8259# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8260 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8261# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8262 else if (low_mach == 2) then
8263# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8264 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))))
8265# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8266 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))))
8267# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8268 vel_l(dir_idx(1)) = vel_l_tmp
8269# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8270 vel_r(dir_idx(1)) = vel_r_tmp
8271# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8272 end if
8273# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8274 end if
8275 else
8276 pcorr = 0._wp
8277 end if
8278
8279
8280# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8281#if defined(MFC_OpenACC)
8282# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8283!$acc loop seq
8284# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8285#elif defined(MFC_OpenMP)
8286# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8287
8288# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8289#endif
8290 do i = 1, contxe
8291 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8292 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsx_vf(j &
8293 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8294 end do
8295
8296 if (bubbles_euler .and. (num_fluids > 1)) then
8297 ! Kill mass transport @ gas density
8298 flux_rsx_vf(j, k, l, contxe) = 0._wp
8299 end if
8300
8301 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
8302
8303 ! Include p_tilde
8304
8305 if (avg_state == 2) then
8306 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
8307 pres_l = pres_l - alpha_l(num_fluids)*pres_l
8308 else
8309 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
8310 end if
8311
8312 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
8313 pres_r = pres_r - alpha_r(num_fluids)*pres_r
8314 else
8315 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
8316 end if
8317 end if
8318
8319
8320# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8321#if defined(MFC_OpenACC)
8322# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8323!$acc loop seq
8324# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8325#elif defined(MFC_OpenMP)
8326# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8327
8328# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8329#endif
8330 do i = 1, num_dims
8331 flux_rsx_vf(j, k, l, &
8332 & contxe + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
8333 & + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
8334 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
8335 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
8336 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
8337 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
8338 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
8339 end do
8340
8341 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
8342 flux_rsx_vf(j, k, l, &
8343 & e_idx) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
8344 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
8345 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s &
8346 & - vel_r(dir_idx(1)))*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) &
8347 & + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
8348
8349 ! Volume fraction flux
8350
8351# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8352#if defined(MFC_OpenACC)
8353# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8354!$acc loop seq
8355# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8356#elif defined(MFC_OpenMP)
8357# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8358
8359# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8360#endif
8361 do i = advxb, advxe
8362 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8363 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsx_vf(j &
8364 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8365 end do
8366
8367 ! Advection velocity source: interface velocity for volume fraction transport
8368
8369# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8370#if defined(MFC_OpenACC)
8371# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8372!$acc loop seq
8373# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8374#elif defined(MFC_OpenMP)
8375# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8376
8377# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8378#endif
8379 do i = 1, num_dims
8380 vel_src_rsx_vf(j, k, l, &
8381 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*(xi_l &
8382 & - 1._wp)) + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*(xi_r &
8383 & - 1._wp))
8384
8385 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
8386 end do
8387
8388 flux_src_rsx_vf(j, k, l, advxb) = vel_src_rsx_vf(j, k, l, dir_idx(1))
8389
8390 ! Add advection flux for bubble variables
8391
8392# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8393#if defined(MFC_OpenACC)
8394# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8395!$acc loop seq
8396# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8397#elif defined(MFC_OpenMP)
8398# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8399
8400# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8401#endif
8402 do i = bubxb, bubxe
8403 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
8404 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8405 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, &
8406 & i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8407 end do
8408
8409 if (qbmm) then
8410 flux_rsx_vf(j, k, l, &
8411 & bubxb) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8412 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8413 end if
8414
8415 if (adv_n) then
8416 flux_rsx_vf(j, k, l, &
8417 & n_idx) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8418 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8419 end if
8420
8421 ! Geometrical source flux for cylindrical coordinates
8422# 2793 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8423# 2810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8424 end do
8425 end do
8426 end do
8427
8428# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8429#if defined(MFC_OpenACC)
8430# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8431!$acc end parallel loop
8432# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8433#elif defined(MFC_OpenMP)
8434# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8435
8436# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8437!$omp end target teams loop
8438# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8439#endif
8440 else
8441 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
8442
8443# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8444
8445# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8446#if defined(MFC_OpenACC)
8447# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8448!$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)
8449# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8450#elif defined(MFC_OpenMP)
8451# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8452
8453# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8454
8455# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8456
8457# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8458!$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)
8459# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8460#endif
8461# 2824 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8462 do l = is3%beg, is3%end
8463 do k = is2%beg, is2%end
8464 do j = is1%beg, is1%end
8465 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8466 rho_l = 0._wp; rho_r = 0._wp
8467 gamma_l = 0._wp; gamma_r = 0._wp
8468 pi_inf_l = 0._wp; pi_inf_r = 0._wp
8469 qv_l = 0._wp; qv_r = 0._wp
8470 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
8471
8472
8473# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8474#if defined(MFC_OpenACC)
8475# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8476!$acc loop seq
8477# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8478#elif defined(MFC_OpenMP)
8479# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8480
8481# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8482#endif
8483 do i = 1, num_fluids
8484 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
8485 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
8486 end do
8487
8488
8489# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8490#if defined(MFC_OpenACC)
8491# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8492!$acc loop seq
8493# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8494#elif defined(MFC_OpenMP)
8495# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8496
8497# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8498#endif
8499 do i = 1, num_dims
8500 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
8501 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
8502 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
8503 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
8504 end do
8505
8506 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
8507 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
8508
8509 ! Change this by splitting it into the cases present in the bubbles_euler
8510 if (mpp_lim) then
8511
8512# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8513#if defined(MFC_OpenACC)
8514# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8515!$acc loop seq
8516# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8517#elif defined(MFC_OpenMP)
8518# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8519
8520# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8521#endif
8522 do i = 1, num_fluids
8523 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
8524 ql_prim_rsx_vf(j, k, l, e_idx + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
8525 & e_idx + i)), 1._wp)
8526 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
8527 qr_prim_rsx_vf(j + 1, k, l, e_idx + i) = min(max(0._wp, qr_prim_rsx_vf(j + 1, &
8528 & k, l, e_idx + i)), 1._wp)
8529 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, e_idx + i)
8530 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
8531 end do
8532
8533
8534# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8535#if defined(MFC_OpenACC)
8536# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8537!$acc loop seq
8538# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8539#elif defined(MFC_OpenMP)
8540# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8541
8542# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8543#endif
8544 do i = 1, num_fluids
8545 ql_prim_rsx_vf(j, k, l, e_idx + i) = ql_prim_rsx_vf(j, k, l, &
8546 & e_idx + i)/max(alpha_l_sum, sgm_eps)
8547 qr_prim_rsx_vf(j + 1, k, l, e_idx + i) = qr_prim_rsx_vf(j + 1, k, l, &
8548 & e_idx + i)/max(alpha_r_sum, sgm_eps)
8549 end do
8550 end if
8551
8552
8553# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8554#if defined(MFC_OpenACC)
8555# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8556!$acc loop seq
8557# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8558#elif defined(MFC_OpenMP)
8559# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8560
8561# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8562#endif
8563 do i = 1, num_fluids
8564 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
8565 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*gammas(i)
8566 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*pi_infs(i)
8567 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
8568
8569 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
8570 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*gammas(i)
8571 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
8572 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
8573 end do
8574
8575 re_max = 0
8576 if (re_size(1) > 0) re_max = 1
8577 if (re_size(2) > 0) re_max = 2
8578
8579 if (viscous) then
8580
8581# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8582#if defined(MFC_OpenACC)
8583# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8584!$acc loop seq
8585# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8586#elif defined(MFC_OpenMP)
8587# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8588
8589# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8590#endif
8591 do i = 1, re_max
8592 re_l(i) = 0._wp
8593 re_r(i) = 0._wp
8594
8595
8596# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8597#if defined(MFC_OpenACC)
8598# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8599!$acc loop seq
8600# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8601#elif defined(MFC_OpenMP)
8602# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8603
8604# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8605#endif
8606 do q = 1, re_size(i)
8607 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
8608 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
8609 end do
8610
8611 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
8612 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
8613 end do
8614 end if
8615
8616 if (chemistry) then
8617 c_sum_yi_phi = 0.0_wp
8618
8619# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8620#if defined(MFC_OpenACC)
8621# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8622!$acc loop seq
8623# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8624#elif defined(MFC_OpenMP)
8625# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8626
8627# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8628#endif
8629 do i = chemxb, chemxe
8630 ys_l(i - chemxb + 1) = ql_prim_rsx_vf(j, k, l, i)
8631 ys_r(i - chemxb + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
8632 end do
8633
8634 call get_mixture_molecular_weight(ys_l, mw_l)
8635 call get_mixture_molecular_weight(ys_r, mw_r)
8636
8637# 2923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8638 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
8639 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
8640# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8641
8642 r_gas_l = gas_constant/mw_l
8643 r_gas_r = gas_constant/mw_r
8644
8645 t_l = pres_l/rho_l/r_gas_l
8646 t_r = pres_r/rho_r/r_gas_r
8647
8648 call get_species_specific_heats_r(t_l, cp_il)
8649 call get_species_specific_heats_r(t_r, cp_ir)
8650
8651 if (chem_params%gamma_method == 1) then
8652 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
8653 gamma_il = cp_il/(cp_il - 1.0_wp)
8654 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
8655
8656 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
8657 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
8658 else if (chem_params%gamma_method == 2) then
8659 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
8660 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
8661 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
8662 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
8663 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
8664
8665 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
8666 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
8667 end if
8668
8669 call get_mixture_energy_mass(t_l, ys_l, e_l)
8670 call get_mixture_energy_mass(t_r, ys_r, e_r)
8671
8672 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
8673 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
8674 h_l = (e_l + pres_l)/rho_l
8675 h_r = (e_r + pres_r)/rho_r
8676 else
8677 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
8678 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
8679
8680 h_l = (e_l + pres_l)/rho_l
8681 h_r = (e_r + pres_r)/rho_r
8682 end if
8683
8684 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
8685 if (hypoelasticity) then
8686
8687# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8688#if defined(MFC_OpenACC)
8689# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8690!$acc loop seq
8691# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8692#elif defined(MFC_OpenMP)
8693# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8694
8695# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8696#endif
8697 do i = 1, strxe - strxb + 1
8698 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
8699 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
8700 end do
8701 g_l = 0._wp
8702 g_r = 0._wp
8703
8704# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8705#if defined(MFC_OpenACC)
8706# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8707!$acc loop seq
8708# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8709#elif defined(MFC_OpenMP)
8710# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8711
8712# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8713#endif
8714 do i = 1, num_fluids
8715 g_l = g_l + alpha_l(i)*gs_rs(i)
8716 g_r = g_r + alpha_r(i)*gs_rs(i)
8717 end do
8718
8719# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8720#if defined(MFC_OpenACC)
8721# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8722!$acc loop seq
8723# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8724#elif defined(MFC_OpenMP)
8725# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8726
8727# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8728#endif
8729 do i = 1, strxe - strxb + 1
8730 ! Elastic contribution to energy if G large enough
8731 if ((g_l > verysmall) .and. (g_r > verysmall)) then
8732 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
8733 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
8734 ! Additional terms in 2D and 3D
8735 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
8736 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
8737 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
8738 end if
8739 end if
8740 end do
8741 end if
8742
8743 ! Hyperelastic stress contribution: strain energy added to total energy
8744 if (hyperelasticity) then
8745
8746# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8747#if defined(MFC_OpenACC)
8748# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8749!$acc loop seq
8750# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8751#elif defined(MFC_OpenMP)
8752# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8753
8754# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8755#endif
8756 do i = 1, num_dims
8757 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, xibeg - 1 + i)
8758 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, xibeg - 1 + i)
8759 end do
8760 g_l = 0._wp
8761 g_r = 0._wp
8762
8763# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8764#if defined(MFC_OpenACC)
8765# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8766!$acc loop seq
8767# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8768#elif defined(MFC_OpenMP)
8769# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8770
8771# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8772#endif
8773 do i = 1, num_fluids
8774 ! Mixture left and right shear modulus
8775 g_l = g_l + alpha_l(i)*gs_rs(i)
8776 g_r = g_r + alpha_r(i)*gs_rs(i)
8777 end do
8778 ! Elastic contribution to energy if G large enough
8779 if (g_l > verysmall .and. g_r > verysmall) then
8780 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, xiend + 1)
8781 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, xiend + 1)
8782 end if
8783
8784# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8785#if defined(MFC_OpenACC)
8786# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8787!$acc loop seq
8788# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8789#elif defined(MFC_OpenMP)
8790# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8791
8792# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8793#endif
8794 do i = 1, b_size - 1
8795 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
8796 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
8797 end do
8798 end if
8799
8800 h_l = (e_l + pres_l)/rho_l
8801 h_r = (e_r + pres_r)/rho_r
8802
8803 if (avg_state == 1) then
8804# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8805 rho_avg = sqrt(rho_l*rho_r)
8806# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8807
8808# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8809 vel_avg_rms = 0._wp
8810# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8811
8812# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8813
8814# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8815#if defined(MFC_OpenACC)
8816# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8817!$acc loop seq
8818# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8819#elif defined(MFC_OpenMP)
8820# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8821
8822# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8823#endif
8824# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8825 do i = 1, num_vels
8826# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8827 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
8828# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8829 end do
8830# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8831
8832# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8833 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
8834# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8835
8836# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8837 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
8838# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8839
8840# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8841 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
8842# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8843
8844# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8845 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
8846# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8847
8848# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8849 if (chemistry) then
8850# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8851 eps = 0.001_wp
8852# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8853 call get_species_enthalpies_rt(t_l, h_il)
8854# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8855 call get_species_enthalpies_rt(t_r, h_ir)
8856# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8857 h_il = h_il*gas_constant/molecular_weights*t_l
8858# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8859 h_ir = h_ir*gas_constant/molecular_weights*t_r
8860# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8861 call get_species_specific_heats_r(t_l, cp_il)
8862# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8863 call get_species_specific_heats_r(t_r, cp_ir)
8864# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8865
8866# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8867 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
8868# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8869 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
8870# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8871 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
8872# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8873 if (abs(t_l - t_r) < eps) then
8874# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8875 ! Case when T_L and T_R are very close
8876# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8877 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
8878# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8879 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
8880# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8881 & - gas_constant/molecular_weights(:)))
8882# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8883 else
8884# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8885 ! Normal calculation when T_L and T_R are sufficiently different
8886# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8887 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
8888# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8889 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
8890# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8891 end if
8892# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8893 gamma_avg = cp_avg/cv_avg
8894# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8895
8896# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8897 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
8898# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8899 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
8900# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8901 end if
8902# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8903 end if
8904# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8905
8906# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8907 if (avg_state == 2) then
8908# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8909 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8910# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8911 vel_avg_rms = 0._wp
8912# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8913
8914# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8915#if defined(MFC_OpenACC)
8916# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8917!$acc loop seq
8918# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8919#elif defined(MFC_OpenMP)
8920# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8921
8922# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8923#endif
8924# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8925 do i = 1, num_vels
8926# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8927 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8928# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8929 end do
8930# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8931
8932# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8933 h_avg = 5.e-1_wp*(h_l + h_r)
8934# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8935 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8936# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8937 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8938# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8939 end if
8940
8941 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
8942 & c_l, qv_l)
8943
8944 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
8945 & c_r, qv_r)
8946
8947 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8948 ! variables are placeholders to call the subroutine.
8949 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
8950 & c_sum_yi_phi, c_avg, qv_avg)
8951
8952 if (viscous) then
8953 if (chemistry) then
8954 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
8955 end if
8956
8957# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8958#if defined(MFC_OpenACC)
8959# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8960!$acc loop seq
8961# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8962#elif defined(MFC_OpenMP)
8963# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8964
8965# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8966#endif
8967 do i = 1, 2
8968 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
8969 end do
8970 end if
8971
8972 ! Low Mach correction
8973 if (low_mach == 2) then
8974 if (riemann_solver == 1 .or. riemann_solver == 5) then
8975# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8976 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8977# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8978 pcorr = 0._wp
8979# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8980
8981# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8982 if (low_mach == 1) then
8983# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8984 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8985# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8986 end if
8987# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8988 else if (riemann_solver == 2) then
8989# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8990 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8991# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8992 pcorr = 0._wp
8993# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8994
8995# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8996 if (low_mach == 1) then
8997# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8998 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))) &
8999# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9000 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9001# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9002 else if (low_mach == 2) then
9003# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9004 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))))
9005# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9006 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))))
9007# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9008 vel_l(dir_idx(1)) = vel_l_tmp
9009# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9010 vel_r(dir_idx(1)) = vel_r_tmp
9011# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9012 end if
9013# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9014 end if
9015 end if
9016
9017 if (wave_speeds == 1) then
9018 if (elasticity) then
9019 ! Elastic wave speed, Rodriguez et al. JCP (2019)
9020 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) &
9021 & ))/rho_l), &
9022 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
9023 & + tau_e_r(dir_idx_tau(1)))/rho_r))
9024 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) &
9025 & ))/rho_r), &
9026 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
9027 & + tau_e_l(dir_idx_tau(1)))/rho_l))
9028 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
9029 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
9030 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
9031 & - vel_r(dir_idx(1))))
9032 else
9033 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
9034 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
9035 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
9036 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
9037 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
9038 end if
9039 else if (wave_speeds == 2) then
9040 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9041
9042 pres_sr = pres_sl
9043
9044 ! Low Mach correction: Thornber et al. JCP (2008)
9045 ms_l = max(1._wp, &
9046 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
9047 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
9048 ms_r = max(1._wp, &
9049 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
9050 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
9051
9052 s_l = vel_l(dir_idx(1)) - c_l*ms_l
9053 s_r = vel_r(dir_idx(1)) + c_r*ms_r
9054
9055 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
9056 end if
9057
9058 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
9059 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
9060
9061 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
9062 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
9063 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
9064
9065 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
9066 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
9067 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
9068
9069 ! Low Mach correction
9070 if (low_mach == 1) then
9071 if (riemann_solver == 1 .or. riemann_solver == 5) then
9072# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9073 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9074# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9075 pcorr = 0._wp
9076# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9077
9078# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9079 if (low_mach == 1) then
9080# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9081 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9082# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9083 end if
9084# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9085 else if (riemann_solver == 2) then
9086# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9087 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9088# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9089 pcorr = 0._wp
9090# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9091
9092# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9093 if (low_mach == 1) then
9094# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9095 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))) &
9096# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9097 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9098# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9099 else if (low_mach == 2) then
9100# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9101 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))))
9102# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9103 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))))
9104# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9105 vel_l(dir_idx(1)) = vel_l_tmp
9106# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9107 vel_r(dir_idx(1)) = vel_r_tmp
9108# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9109 end if
9110# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9111 end if
9112 else
9113 pcorr = 0._wp
9114 end if
9115
9116 ! COMPUTING THE HLLC FLUXES MASS FLUX.
9117
9118# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9119#if defined(MFC_OpenACC)
9120# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9121!$acc loop seq
9122# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9123#elif defined(MFC_OpenMP)
9124# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9125
9126# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9127#endif
9128 do i = 1, contxe
9129 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9130 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsx_vf(j &
9131 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9132 end do
9133
9134 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
9135
9136# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9137#if defined(MFC_OpenACC)
9138# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9139!$acc loop seq
9140# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9141#elif defined(MFC_OpenMP)
9142# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9143
9144# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9145#endif
9146 do i = 1, num_dims
9147 flux_rsx_vf(j, k, l, &
9148 & contxe + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
9149 & + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
9150 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
9151 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
9152 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
9153 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
9154 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
9155 end do
9156
9157 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
9158 flux_rsx_vf(j, k, l, &
9159 & e_idx) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
9160 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1))))) - e_l)) &
9161 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s &
9162 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r)) &
9163 & + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
9164
9165 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
9166 if (elasticity) then
9167 flux_ene_e = 0._wp
9168
9169# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9170#if defined(MFC_OpenACC)
9171# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9172!$acc loop seq
9173# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9174#elif defined(MFC_OpenMP)
9175# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9176
9177# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9178#endif
9179 do i = 1, num_dims
9180 ! MOMENTUM ELASTIC FLUX.
9181 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = flux_rsx_vf(j, k, l, &
9182 & contxe + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
9183 & - xi_p*tau_e_r(dir_idx_tau(i))
9184 ! ENERGY ELASTIC FLUX.
9185 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
9186 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
9187 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
9188 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
9189 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
9190 end do
9191 flux_rsx_vf(j, k, l, e_idx) = flux_rsx_vf(j, k, l, e_idx) + flux_ene_e
9192 end if
9193
9194 ! HYPOELASTIC STRESS EVOLUTION FLUX.
9195 if (hypoelasticity) then
9196
9197# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9198#if defined(MFC_OpenACC)
9199# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9200!$acc loop seq
9201# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9202#elif defined(MFC_OpenMP)
9203# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9204
9205# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9206#endif
9207 do i = 1, strxe - strxb + 1
9208 flux_rsx_vf(j, k, l, &
9209 & strxb - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
9210 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
9211 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
9212 end do
9213 end if
9214
9215 ! VOLUME FRACTION FLUX.
9216
9217# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9218#if defined(MFC_OpenACC)
9219# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9220!$acc loop seq
9221# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9222#elif defined(MFC_OpenMP)
9223# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9224
9225# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9226#endif
9227 do i = advxb, advxe
9228 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9229 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsx_vf(j &
9230 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9231 end do
9232
9233 ! VOLUME FRACTION SOURCE FLUX.
9234
9235# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9236#if defined(MFC_OpenACC)
9237# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9238!$acc loop seq
9239# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9240#elif defined(MFC_OpenMP)
9241# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9242
9243# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9244#endif
9245 do i = 1, num_dims
9246 vel_src_rsx_vf(j, k, l, &
9247 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*(xi_l &
9248 & - 1._wp)) + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*(xi_r &
9249 & - 1._wp))
9250 end do
9251
9252 ! COLOR FUNCTION FLUX
9253 if (surface_tension) then
9254 flux_rsx_vf(j, k, l, c_idx) = xi_m*ql_prim_rsx_vf(j, k, l, &
9255 & c_idx)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9256 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
9257 & c_idx)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9258 end if
9259
9260 ! Hyperelastic reference map flux for material deformation tracking
9261 if (hyperelasticity) then
9262
9263# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9264#if defined(MFC_OpenACC)
9265# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9266!$acc loop seq
9267# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9268#elif defined(MFC_OpenMP)
9269# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9270
9271# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9272#endif
9273 do i = 1, num_dims
9274 flux_rsx_vf(j, k, l, &
9275 & xibeg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
9276 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
9277 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
9278 end do
9279 end if
9280
9281 flux_src_rsx_vf(j, k, l, advxb) = vel_src_rsx_vf(j, k, l, dir_idx(1))
9282
9283 if (chemistry) then
9284
9285# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9286#if defined(MFC_OpenACC)
9287# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9288!$acc loop seq
9289# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9290#elif defined(MFC_OpenMP)
9291# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9292
9293# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9294#endif
9295 do i = chemxb, chemxe
9296 y_l = ql_prim_rsx_vf(j, k, l, i)
9297 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
9298
9299 flux_rsx_vf(j, k, l, &
9300 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9301 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9302 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
9303 end do
9304 end if
9305
9306 ! Geometrical source flux for cylindrical coordinates
9307# 3248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9308# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9309 end do
9310 end do
9311 end do
9312
9313# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9314#if defined(MFC_OpenACC)
9315# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9316!$acc end parallel loop
9317# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9318#elif defined(MFC_OpenMP)
9319# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9320
9321# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9322!$omp end target teams loop
9323# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9324#endif
9325 end if
9326 end if
9327# 1787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9328 if (norm_dir == 2) then
9329 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
9330 if (model_eqns == 3) then
9331 ! 6-equation model (model_eqns=3): separate phasic internal energies
9332
9333# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9334
9335# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9336#if defined(MFC_OpenACC)
9337# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9338!$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)
9339# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9340#elif defined(MFC_OpenMP)
9341# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9342
9343# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9344
9345# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9346
9347# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9348!$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)
9349# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9350#endif
9351# 1801 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9352 do l = is3%beg, is3%end
9353 do k = is2%beg, is2%end
9354 do j = is1%beg, is1%end
9355 vel_l_rms = 0._wp; vel_r_rms = 0._wp
9356 rho_l = 0._wp; rho_r = 0._wp
9357 gamma_l = 0._wp; gamma_r = 0._wp
9358 pi_inf_l = 0._wp; pi_inf_r = 0._wp
9359 qv_l = 0._wp; qv_r = 0._wp
9360 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
9361
9362
9363# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9364#if defined(MFC_OpenACC)
9365# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9366!$acc loop seq
9367# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9368#elif defined(MFC_OpenMP)
9369# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9370
9371# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9372#endif
9373 do i = 1, num_dims
9374 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
9375 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
9376 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
9377 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
9378 end do
9379
9380 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
9381 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
9382
9383 rho_l = 0._wp
9384 gamma_l = 0._wp
9385 pi_inf_l = 0._wp
9386 qv_l = 0._wp
9387
9388 rho_r = 0._wp
9389 gamma_r = 0._wp
9390 pi_inf_r = 0._wp
9391 qv_r = 0._wp
9392
9393 alpha_l_sum = 0._wp
9394 alpha_r_sum = 0._wp
9395
9396 if (mpp_lim) then
9397
9398# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9399#if defined(MFC_OpenACC)
9400# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9401!$acc loop seq
9402# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9403#elif defined(MFC_OpenMP)
9404# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9405
9406# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9407#endif
9408 do i = 1, num_fluids
9409 ql_prim_rsy_vf(j, k, l, i) = max(0._wp, ql_prim_rsy_vf(j, k, l, i))
9410 ql_prim_rsy_vf(j, k, l, e_idx + i) = min(max(0._wp, ql_prim_rsy_vf(j, k, l, &
9411 & e_idx + i)), 1._wp)
9412 alpha_l_sum = alpha_l_sum + ql_prim_rsy_vf(j, k, l, e_idx + i)
9413 end do
9414
9415
9416# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9417#if defined(MFC_OpenACC)
9418# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9419!$acc loop seq
9420# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9421#elif defined(MFC_OpenMP)
9422# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9423
9424# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9425#endif
9426 do i = 1, num_fluids
9427 qr_prim_rsy_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsy_vf(j + 1, k, l, i))
9428 qr_prim_rsy_vf(j + 1, k, l, e_idx + i) = min(max(0._wp, qr_prim_rsy_vf(j + 1, &
9429 & k, l, e_idx + i)), 1._wp)
9430 alpha_r_sum = alpha_r_sum + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
9431 end do
9432
9433
9434# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9435#if defined(MFC_OpenACC)
9436# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9437!$acc loop seq
9438# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9439#elif defined(MFC_OpenMP)
9440# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9441
9442# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9443#endif
9444 do i = 1, num_fluids
9445 ql_prim_rsy_vf(j, k, l, e_idx + i) = ql_prim_rsy_vf(j, k, l, &
9446 & e_idx + i)/max(alpha_l_sum, sgm_eps)
9447 qr_prim_rsy_vf(j + 1, k, l, e_idx + i) = qr_prim_rsy_vf(j + 1, k, l, &
9448 & e_idx + i)/max(alpha_r_sum, sgm_eps)
9449 end do
9450 end if
9451
9452
9453# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9454#if defined(MFC_OpenACC)
9455# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9456!$acc loop seq
9457# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9458#elif defined(MFC_OpenMP)
9459# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9460
9461# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9462#endif
9463 do i = 1, num_fluids
9464 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
9465 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*gammas(i)
9466 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*pi_infs(i)
9467 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
9468
9469 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
9470 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*gammas(i)
9471 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
9472 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
9473
9474 alpha_l(i) = ql_prim_rsy_vf(j, k, l, advxb + i - 1)
9475 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, advxb + i - 1)
9476 end do
9477
9478 if (viscous) then
9479
9480# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9481#if defined(MFC_OpenACC)
9482# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9483!$acc loop seq
9484# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9485#elif defined(MFC_OpenMP)
9486# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9487
9488# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9489#endif
9490 do i = 1, 2
9491 re_l(i) = dflt_real
9492 re_r(i) = dflt_real
9493 if (re_size(i) > 0) re_l(i) = 0._wp
9494 if (re_size(i) > 0) re_r(i) = 0._wp
9495
9496# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9497#if defined(MFC_OpenACC)
9498# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9499!$acc loop seq
9500# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9501#elif defined(MFC_OpenMP)
9502# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9503
9504# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9505#endif
9506 do q = 1, re_size(i)
9507 re_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + re_idx(i, q))/res_gs(i, q) + re_l(i)
9508 re_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + re_idx(i, q))/res_gs(i, q) + re_r(i)
9509 end do
9510 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
9511 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
9512 end do
9513 end if
9514
9515 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
9516 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
9517
9518 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
9519 if (hypoelasticity) then
9520
9521# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9522#if defined(MFC_OpenACC)
9523# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9524!$acc loop seq
9525# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9526#elif defined(MFC_OpenMP)
9527# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9528
9529# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9530#endif
9531 do i = 1, strxe - strxb + 1
9532 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
9533 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
9534 end do
9535 g_l = 0._wp; g_r = 0._wp
9536
9537# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9538#if defined(MFC_OpenACC)
9539# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9540!$acc loop seq
9541# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9542#elif defined(MFC_OpenMP)
9543# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9544
9545# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9546#endif
9547 do i = 1, num_fluids
9548 g_l = g_l + alpha_l(i)*gs_rs(i)
9549 g_r = g_r + alpha_r(i)*gs_rs(i)
9550 end do
9551
9552# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9553#if defined(MFC_OpenACC)
9554# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9555!$acc loop seq
9556# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9557#elif defined(MFC_OpenMP)
9558# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9559
9560# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9561#endif
9562 do i = 1, strxe - strxb + 1
9563 ! Elastic contribution to energy if G large enough
9564 if ((g_l > verysmall) .and. (g_r > verysmall)) then
9565 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
9566 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
9567 ! Additional terms in 2D and 3D
9568 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
9569 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
9570 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
9571 end if
9572 end if
9573 end do
9574 end if
9575
9576 ! Hyperelastic stress contribution: strain energy added to total energy
9577 if (hyperelasticity) then
9578
9579# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9580#if defined(MFC_OpenACC)
9581# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9582!$acc loop seq
9583# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9584#elif defined(MFC_OpenMP)
9585# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9586
9587# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9588#endif
9589 do i = 1, num_dims
9590 xi_field_l(i) = ql_prim_rsy_vf(j, k, l, xibeg - 1 + i)
9591 xi_field_r(i) = qr_prim_rsy_vf(j + 1, k, l, xibeg - 1 + i)
9592 end do
9593 g_l = 0._wp; g_r = 0._wp
9594
9595# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9596#if defined(MFC_OpenACC)
9597# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9598!$acc loop seq
9599# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9600#elif defined(MFC_OpenMP)
9601# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9602
9603# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9604#endif
9605 do i = 1, num_fluids
9606 ! Mixture left and right shear modulus
9607 g_l = g_l + alpha_l(i)*gs_rs(i)
9608 g_r = g_r + alpha_r(i)*gs_rs(i)
9609 end do
9610 ! Elastic contribution to energy if G large enough
9611 if (g_l > verysmall .and. g_r > verysmall) then
9612 e_l = e_l + g_l*ql_prim_rsy_vf(j, k, l, xiend + 1)
9613 e_r = e_r + g_r*qr_prim_rsy_vf(j + 1, k, l, xiend + 1)
9614 end if
9615
9616# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9617#if defined(MFC_OpenACC)
9618# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9619!$acc loop seq
9620# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9621#elif defined(MFC_OpenMP)
9622# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9623
9624# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9625#endif
9626 do i = 1, b_size - 1
9627 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
9628 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
9629 end do
9630 end if
9631
9632 h_l = (e_l + pres_l)/rho_l
9633 h_r = (e_r + pres_r)/rho_r
9634
9635 if (avg_state == 1) then
9636# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9637 rho_avg = sqrt(rho_l*rho_r)
9638# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9639
9640# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9641 vel_avg_rms = 0._wp
9642# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9643
9644# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9645
9646# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9647#if defined(MFC_OpenACC)
9648# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9649!$acc loop seq
9650# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9651#elif defined(MFC_OpenMP)
9652# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9653
9654# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9655#endif
9656# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9657 do i = 1, num_vels
9658# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9659 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
9660# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9661 end do
9662# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9663
9664# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9665 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
9666# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9667
9668# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9669 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
9670# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9671
9672# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9673 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
9674# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9675
9676# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9677 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
9678# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9679
9680# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9681 if (chemistry) then
9682# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9683 eps = 0.001_wp
9684# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9685 call get_species_enthalpies_rt(t_l, h_il)
9686# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9687 call get_species_enthalpies_rt(t_r, h_ir)
9688# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9689 h_il = h_il*gas_constant/molecular_weights*t_l
9690# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9691 h_ir = h_ir*gas_constant/molecular_weights*t_r
9692# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9693 call get_species_specific_heats_r(t_l, cp_il)
9694# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9695 call get_species_specific_heats_r(t_r, cp_ir)
9696# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9697
9698# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9699 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
9700# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9701 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
9702# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9703 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
9704# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9705 if (abs(t_l - t_r) < eps) then
9706# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9707 ! Case when T_L and T_R are very close
9708# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9709 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
9710# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9711 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
9712# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9713 & - gas_constant/molecular_weights(:)))
9714# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9715 else
9716# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9717 ! Normal calculation when T_L and T_R are sufficiently different
9718# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9719 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
9720# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9721 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
9722# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9723 end if
9724# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9725 gamma_avg = cp_avg/cv_avg
9726# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9727
9728# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9729 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
9730# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9731 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
9732# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9733 end if
9734# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9735 end if
9736# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9737
9738# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9739 if (avg_state == 2) then
9740# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9741 rho_avg = 5.e-1_wp*(rho_l + rho_r)
9742# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9743 vel_avg_rms = 0._wp
9744# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9745
9746# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9747#if defined(MFC_OpenACC)
9748# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9749!$acc loop seq
9750# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9751#elif defined(MFC_OpenMP)
9752# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9753
9754# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9755#endif
9756# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9757 do i = 1, num_vels
9758# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9759 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
9760# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9761 end do
9762# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9763
9764# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9765 h_avg = 5.e-1_wp*(h_l + h_r)
9766# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9767 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
9768# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9769 qv_avg = 5.e-1_wp*(qv_l + qv_r)
9770# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9771 end if
9772
9773 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
9774 & c_l, qv_l)
9775
9776 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
9777 & c_r, qv_r)
9778
9779 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
9780 ! variables are placeholders to call the subroutine.
9781 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
9782 & 0._wp, c_avg, qv_avg)
9783
9784 if (viscous) then
9785
9786# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9787#if defined(MFC_OpenACC)
9788# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9789!$acc loop seq
9790# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9791#elif defined(MFC_OpenMP)
9792# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9793
9794# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9795#endif
9796 do i = 1, 2
9797 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
9798 end do
9799 end if
9800
9801 ! Low Mach correction
9802 if (low_mach == 2) then
9803 if (riemann_solver == 1 .or. riemann_solver == 5) then
9804# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9805 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9806# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9807 pcorr = 0._wp
9808# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9809
9810# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9811 if (low_mach == 1) then
9812# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9813 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9814# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9815 end if
9816# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9817 else if (riemann_solver == 2) then
9818# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9819 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9820# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9821 pcorr = 0._wp
9822# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9823
9824# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9825 if (low_mach == 1) then
9826# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9827 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))) &
9828# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9829 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9830# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9831 else if (low_mach == 2) then
9832# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9833 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))))
9834# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9835 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))))
9836# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9837 vel_l(dir_idx(1)) = vel_l_tmp
9838# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9839 vel_r(dir_idx(1)) = vel_r_tmp
9840# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9841 end if
9842# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9843 end if
9844 end if
9845
9846 ! COMPUTING THE DIRECT WAVE SPEEDS
9847 if (wave_speeds == 1) then
9848 if (elasticity) then
9849 ! Elastic wave speed, Rodriguez et al. JCP (2019)
9850 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) &
9851 & ))/rho_l), &
9852 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
9853 & + tau_e_r(dir_idx_tau(1)))/rho_r))
9854 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) &
9855 & ))/rho_r), &
9856 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
9857 & + tau_e_l(dir_idx_tau(1)))/rho_l))
9858 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
9859 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
9860 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
9861 & - vel_r(dir_idx(1))))
9862 else
9863 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
9864 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
9865 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
9866 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
9867 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
9868 end if
9869 else if (wave_speeds == 2) then
9870 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9871
9872 pres_sr = pres_sl
9873
9874 ! Low Mach correction: Thornber et al. JCP (2008)
9875 ms_l = max(1._wp, &
9876 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
9877 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
9878 ms_r = max(1._wp, &
9879 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
9880 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
9881
9882 s_l = vel_l(dir_idx(1)) - c_l*ms_l
9883 s_r = vel_r(dir_idx(1)) + c_r*ms_r
9884
9885 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
9886 end if
9887
9888 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
9889 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
9890
9891 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
9892 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
9893 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
9894
9895 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
9896 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
9897 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
9898
9899 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
9900 xi_mp = -min(0._wp, sign(1._wp, s_l))
9901 xi_pp = max(0._wp, sign(1._wp, s_r))
9902
9903 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 &
9904 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
9905 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
9906 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
9907 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
9908
9909 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))
9910
9911 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 &
9912 & - vel_r(dir_idx(1)))
9913
9914 ! Low Mach correction
9915 if (low_mach == 1) then
9916 if (riemann_solver == 1 .or. riemann_solver == 5) then
9917# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9918 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9919# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9920 pcorr = 0._wp
9921# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9922
9923# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9924 if (low_mach == 1) then
9925# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9926 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9927# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9928 end if
9929# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9930 else if (riemann_solver == 2) then
9931# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9932 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9933# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9934 pcorr = 0._wp
9935# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9936
9937# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9938 if (low_mach == 1) then
9939# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9940 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))) &
9941# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9942 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9943# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9944 else if (low_mach == 2) then
9945# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9946 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))))
9947# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9948 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))))
9949# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9950 vel_l(dir_idx(1)) = vel_l_tmp
9951# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9952 vel_r(dir_idx(1)) = vel_r_tmp
9953# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9954 end if
9955# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9956 end if
9957 else
9958 pcorr = 0._wp
9959 end if
9960
9961 ! COMPUTING FLUXES MASS FLUX.
9962
9963# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9964#if defined(MFC_OpenACC)
9965# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9966!$acc loop seq
9967# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9968#elif defined(MFC_OpenMP)
9969# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9970
9971# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9972#endif
9973 do i = 1, contxe
9974 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
9975 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsy_vf(j &
9976 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9977 end do
9978
9979 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
9980
9981# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9982#if defined(MFC_OpenACC)
9983# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9984!$acc loop seq
9985# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9986#elif defined(MFC_OpenMP)
9987# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9988
9989# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9990#endif
9991 do i = 1, num_dims
9992 flux_rsy_vf(j, k, l, &
9993 & contxe + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
9994 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
9995 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l) &
9996 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
9997 end do
9998
9999 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
10000 flux_rsy_vf(j, k, l, e_idx) = (e_star + p_star)*vel_k_star + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
10001
10002 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
10003 if (elasticity) then
10004 flux_ene_e = 0._wp
10005
10006# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10007#if defined(MFC_OpenACC)
10008# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10009!$acc loop seq
10010# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10011#elif defined(MFC_OpenMP)
10012# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10013
10014# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10015#endif
10016 do i = 1, num_dims
10017 ! MOMENTUM ELASTIC FLUX.
10018 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = flux_rsy_vf(j, k, l, &
10019 & contxe + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
10020 & - xi_p*tau_e_r(dir_idx_tau(i))
10021 ! ENERGY ELASTIC FLUX.
10022 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
10023 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
10024 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
10025 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
10026 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
10027 end do
10028 flux_rsy_vf(j, k, l, e_idx) = flux_rsy_vf(j, k, l, e_idx) + flux_ene_e
10029 end if
10030
10031 ! VOLUME FRACTION FLUX.
10032
10033# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10034#if defined(MFC_OpenACC)
10035# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10036!$acc loop seq
10037# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10038#elif defined(MFC_OpenMP)
10039# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10040
10041# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10042#endif
10043 do i = advxb, advxe
10044 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
10045 & i)*s_s + xi_p*qr_prim_rsy_vf(j + 1, k, l, i)*s_s
10046 end do
10047
10048 ! Advection velocity source: interface velocity for volume fraction transport
10049
10050# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10051#if defined(MFC_OpenACC)
10052# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10053!$acc loop seq
10054# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10055#elif defined(MFC_OpenMP)
10056# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10057
10058# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10059#endif
10060 do i = 1, num_dims
10061 vel_src_rsy_vf(j, k, l, &
10062 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
10063 & *(s_s*(xi_mp*(xi_l - 1) + 1) - vel_l(dir_idx(i)))) &
10064 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(s_s*(xi_pp*(xi_r - 1) &
10065 & + 1) - vel_r(dir_idx(i))))
10066 end do
10067
10068 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
10069 ! energy flux
10070
10071# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10072#if defined(MFC_OpenACC)
10073# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10074!$acc loop seq
10075# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10076#elif defined(MFC_OpenMP)
10077# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10078
10079# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10080#endif
10081 do i = 1, num_fluids
10082 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
10083 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
10084 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
10085 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
10086 & + pres_r)
10087
10088 flux_rsy_vf(j, k, l, i + intxb - 1) = ((xi_m*ql_prim_rsy_vf(j, k, l, &
10089 & i + advxb - 1) + xi_p*qr_prim_rsy_vf(j + 1, k, l, &
10090 & i + advxb - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
10091 & + (xi_m*ql_prim_rsy_vf(j, k, l, &
10092 & i + contxb - 1) + xi_p*qr_prim_rsy_vf(j + 1, k, l, &
10093 & i + contxb - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
10094 & *pcorr*s_s*(xi_m*ql_prim_rsy_vf(j, k, l, &
10095 & i + advxb - 1) + xi_p*qr_prim_rsy_vf(j + 1, k, l, i + advxb - 1))
10096 end do
10097
10098 flux_src_rsy_vf(j, k, l, advxb) = vel_src_rsy_vf(j, k, l, dir_idx(1))
10099
10100 ! HYPOELASTIC STRESS EVOLUTION FLUX.
10101 if (hypoelasticity) then
10102
10103# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10104#if defined(MFC_OpenACC)
10105# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10106!$acc loop seq
10107# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10108#elif defined(MFC_OpenMP)
10109# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10110
10111# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10112#endif
10113 do i = 1, strxe - strxb + 1
10114 flux_rsy_vf(j, k, l, &
10115 & strxb - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
10116 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
10117 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
10118 end do
10119 end if
10120
10121 ! Hyperelastic reference map flux for material deformation tracking
10122 if (hyperelasticity) then
10123
10124# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10125#if defined(MFC_OpenACC)
10126# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10127!$acc loop seq
10128# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10129#elif defined(MFC_OpenMP)
10130# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10131
10132# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10133#endif
10134 do i = 1, num_dims
10135 flux_rsy_vf(j, k, l, &
10136 & xibeg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
10137 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
10138 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
10139 end do
10140 end if
10141
10142 ! COLOR FUNCTION FLUX
10143 if (surface_tension) then
10144 flux_rsy_vf(j, k, l, c_idx) = (xi_m*ql_prim_rsy_vf(j, k, l, &
10145 & c_idx) + xi_p*qr_prim_rsy_vf(j + 1, k, l, c_idx))*s_s
10146 end if
10147
10148 ! Geometrical source flux for cylindrical coordinates
10149# 2163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10150 if (cyl_coord) then
10151 ! Substituting the advective flux into the inviscid geometrical source flux
10152
10153# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10154#if defined(MFC_OpenACC)
10155# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10156!$acc loop seq
10157# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10158#elif defined(MFC_OpenMP)
10159# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10160
10161# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10162#endif
10163 do i = 1, e_idx
10164 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
10165 end do
10166
10167# 2169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10168#if defined(MFC_OpenACC)
10169# 2169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10170!$acc loop seq
10171# 2169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10172#elif defined(MFC_OpenMP)
10173# 2169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10174
10175# 2169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10176#endif
10177 do i = intxb, intxe
10178 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
10179 end do
10180 ! Recalculating the radial momentum geometric source flux
10181 flux_gsrc_rsy_vf(j, k, l, momxb - 1 + dir_idx(1)) = flux_gsrc_rsy_vf(j, k, l, &
10182 & momxb - 1 + dir_idx(1)) - p_star
10183 ! Geometrical source of the void fraction(s) is zero
10184
10185# 2177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10186#if defined(MFC_OpenACC)
10187# 2177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10188!$acc loop seq
10189# 2177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10190#elif defined(MFC_OpenMP)
10191# 2177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10192
10193# 2177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10194#endif
10195 do i = advxb, advxe
10196 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
10197 end do
10198 end if
10199# 2183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10200# 2195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10201 end do
10202 end do
10203 end do
10204
10205# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10206#if defined(MFC_OpenACC)
10207# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10208!$acc end parallel loop
10209# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10210#elif defined(MFC_OpenMP)
10211# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10212
10213# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10214!$omp end target teams loop
10215# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10216#endif
10217 else if (model_eqns == 4) then
10218 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
10219
10220# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10221
10222# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10223#if defined(MFC_OpenACC)
10224# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10225!$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)
10226# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10227#elif defined(MFC_OpenMP)
10228# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10229
10230# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10231
10232# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10233
10234# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10235!$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)
10236# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10237#endif
10238# 2210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10239 do l = is3%beg, is3%end
10240 do k = is2%beg, is2%end
10241 do j = is1%beg, is1%end
10242 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10243 rho_l = 0._wp; rho_r = 0._wp
10244 gamma_l = 0._wp; gamma_r = 0._wp
10245 pi_inf_l = 0._wp; pi_inf_r = 0._wp
10246 qv_l = 0._wp; qv_r = 0._wp
10247
10248
10249# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10250#if defined(MFC_OpenACC)
10251# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10252!$acc loop seq
10253# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10254#elif defined(MFC_OpenMP)
10255# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10256
10257# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10258#endif
10259 do i = 1, contxe
10260 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
10261 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
10262 end do
10263
10264
10265# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10266#if defined(MFC_OpenACC)
10267# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10268!$acc loop seq
10269# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10270#elif defined(MFC_OpenMP)
10271# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10272
10273# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10274#endif
10275 do i = 1, num_dims
10276 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
10277 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
10278 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
10279 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
10280 end do
10281
10282
10283# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10284#if defined(MFC_OpenACC)
10285# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10286!$acc loop seq
10287# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10288#elif defined(MFC_OpenMP)
10289# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10290
10291# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10292#endif
10293 do i = 1, num_fluids
10294 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
10295 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
10296 end do
10297
10298# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10299#if defined(MFC_OpenACC)
10300# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10301!$acc loop seq
10302# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10303#elif defined(MFC_OpenMP)
10304# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10305
10306# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10307#endif
10308 do i = 1, num_fluids
10309 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
10310 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
10311 end do
10312
10313
10314# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10315#if defined(MFC_OpenACC)
10316# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10317!$acc loop seq
10318# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10319#elif defined(MFC_OpenMP)
10320# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10321
10322# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10323#endif
10324 do i = 1, num_fluids
10325 rho_l = rho_l + alpha_rho_l(i)
10326 gamma_l = gamma_l + alpha_l(i)*gammas(i)
10327 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
10328 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
10329
10330 rho_r = rho_r + alpha_rho_r(i)
10331 gamma_r = gamma_r + alpha_r(i)*gammas(i)
10332 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
10333 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
10334 end do
10335
10336 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
10337 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
10338
10339 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
10340 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
10341
10342 h_l = (e_l + pres_l)/rho_l
10343 h_r = (e_r + pres_r)/rho_r
10344
10345 if (avg_state == 1) then
10346# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10347 rho_avg = sqrt(rho_l*rho_r)
10348# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10349
10350# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10351 vel_avg_rms = 0._wp
10352# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10353
10354# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10355
10356# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10357#if defined(MFC_OpenACC)
10358# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10359!$acc loop seq
10360# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10361#elif defined(MFC_OpenMP)
10362# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10363
10364# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10365#endif
10366# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10367 do i = 1, num_vels
10368# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10369 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
10370# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10371 end do
10372# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10373
10374# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10375 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
10376# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10377
10378# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10379 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
10380# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10381
10382# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10383 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
10384# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10385
10386# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10387 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
10388# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10389
10390# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10391 if (chemistry) then
10392# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10393 eps = 0.001_wp
10394# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10395 call get_species_enthalpies_rt(t_l, h_il)
10396# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10397 call get_species_enthalpies_rt(t_r, h_ir)
10398# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10399 h_il = h_il*gas_constant/molecular_weights*t_l
10400# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10401 h_ir = h_ir*gas_constant/molecular_weights*t_r
10402# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10403 call get_species_specific_heats_r(t_l, cp_il)
10404# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10405 call get_species_specific_heats_r(t_r, cp_ir)
10406# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10407
10408# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10409 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
10410# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10411 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
10412# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10413 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
10414# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10415 if (abs(t_l - t_r) < eps) then
10416# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10417 ! Case when T_L and T_R are very close
10418# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10419 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
10420# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10421 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
10422# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10423 & - gas_constant/molecular_weights(:)))
10424# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10425 else
10426# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10427 ! Normal calculation when T_L and T_R are sufficiently different
10428# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10429 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
10430# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10431 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
10432# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10433 end if
10434# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10435 gamma_avg = cp_avg/cv_avg
10436# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10437
10438# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10439 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
10440# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10441 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
10442# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10443 end if
10444# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10445 end if
10446# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10447
10448# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10449 if (avg_state == 2) then
10450# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10451 rho_avg = 5.e-1_wp*(rho_l + rho_r)
10452# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10453 vel_avg_rms = 0._wp
10454# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10455
10456# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10457#if defined(MFC_OpenACC)
10458# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10459!$acc loop seq
10460# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10461#elif defined(MFC_OpenMP)
10462# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10463
10464# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10465#endif
10466# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10467 do i = 1, num_vels
10468# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10469 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
10470# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10471 end do
10472# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10473
10474# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10475 h_avg = 5.e-1_wp*(h_l + h_r)
10476# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10477 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
10478# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10479 qv_avg = 5.e-1_wp*(qv_l + qv_r)
10480# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10481 end if
10482
10483 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
10484 & c_l, qv_l)
10485
10486 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
10487 & c_r, qv_r)
10488
10489 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
10490 ! variables are placeholders to call the subroutine.
10491
10492 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
10493 & 0._wp, c_avg, qv_avg)
10494
10495 if (wave_speeds == 1) then
10496 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
10497 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
10498
10499 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
10500 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
10501 & - rho_r*(s_r - vel_r(dir_idx(1))))
10502 else if (wave_speeds == 2) then
10503 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
10504
10505 pres_sr = pres_sl
10506
10507 ! Low Mach correction: Thornber et al. JCP (2008)
10508 ms_l = max(1._wp, &
10509 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
10510 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
10511 ms_r = max(1._wp, &
10512 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
10513 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
10514
10515 s_l = vel_l(dir_idx(1)) - c_l*ms_l
10516 s_r = vel_r(dir_idx(1)) + c_r*ms_r
10517
10518 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
10519 end if
10520
10521 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
10522 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
10523
10524 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
10525 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
10526 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
10527
10528 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
10529 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
10530 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
10531
10532
10533# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10534#if defined(MFC_OpenACC)
10535# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10536!$acc loop seq
10537# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10538#elif defined(MFC_OpenMP)
10539# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10540
10541# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10542#endif
10543 do i = 1, contxe
10544 flux_rsy_vf(j, k, l, &
10545 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
10546 & + xi_p*alpha_rho_r(i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10547 end do
10548
10549 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
10550
10551# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10552#if defined(MFC_OpenACC)
10553# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10554!$acc loop seq
10555# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10556#elif defined(MFC_OpenMP)
10557# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10558
10559# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10560#endif
10561 do i = 1, num_dims
10562 flux_rsy_vf(j, k, l, &
10563 & contxe + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
10564 & + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
10565 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
10566 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
10567 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
10568 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
10569 end do
10570
10571 if (bubbles_euler) then
10572 ! Put p_tilde in
10573
10574# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10575#if defined(MFC_OpenACC)
10576# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10577!$acc loop seq
10578# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10579#elif defined(MFC_OpenMP)
10580# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10581
10582# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10583#endif
10584 do i = 1, num_dims
10585 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = flux_rsy_vf(j, k, l, &
10586 & contxe + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l)) &
10587 & + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
10588 end do
10589 end if
10590
10591 flux_rsy_vf(j, k, l, e_idx) = 0._wp
10592
10593
10594# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10595#if defined(MFC_OpenACC)
10596# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10597!$acc loop seq
10598# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10599#elif defined(MFC_OpenMP)
10600# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10601
10602# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10603#endif
10604 do i = alf_idx, alf_idx ! only advect the void fraction
10605 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
10606 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsy_vf(j &
10607 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10608 end do
10609
10610 ! Advection velocity source: interface velocity for volume fraction transport
10611
10612# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10613#if defined(MFC_OpenACC)
10614# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10615!$acc loop seq
10616# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10617#elif defined(MFC_OpenMP)
10618# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10619
10620# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10621#endif
10622 do i = 1, num_dims
10623 vel_src_rsy_vf(j, k, l, dir_idx(i)) = 0._wp
10624 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
10625 end do
10626
10627 flux_src_rsy_vf(j, k, l, advxb) = vel_src_rsy_vf(j, k, l, dir_idx(1))
10628
10629 ! Add advection flux for bubble variables
10630 if (bubbles_euler) then
10631
10632# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10633#if defined(MFC_OpenACC)
10634# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10635!$acc loop seq
10636# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10637#elif defined(MFC_OpenMP)
10638# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10639
10640# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10641#endif
10642 do i = bubxb, bubxe
10643 flux_rsy_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsy_vf(j, k, l, &
10644 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
10645 & + xi_p*nbub_r*qr_prim_rsy_vf(j + 1, k, l, &
10646 & i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10647 end do
10648 end if
10649
10650 ! Geometrical source flux for cylindrical coordinates
10651
10652# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10653 if (cyl_coord) then
10654 ! Substituting the advective flux into the inviscid geometrical source flux
10655
10656# 2380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10657#if defined(MFC_OpenACC)
10658# 2380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10659!$acc loop seq
10660# 2380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10661#elif defined(MFC_OpenMP)
10662# 2380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10663
10664# 2380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10665#endif
10666 do i = 1, e_idx
10667 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
10668 end do
10669 ! Recalculating the radial momentum geometric source flux
10670 flux_gsrc_rsy_vf(j, k, l, &
10671 & contxe + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
10672 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
10673 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
10674 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
10675 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp &
10676 & - dir_flg(dir_idx(1)))*vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
10677 ! Geometrical source of the void fraction(s) is zero
10678
10679# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10680#if defined(MFC_OpenACC)
10681# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10682!$acc loop seq
10683# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10684#elif defined(MFC_OpenMP)
10685# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10686
10687# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10688#endif
10689 do i = advxb, advxe
10690 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
10691 end do
10692 end if
10693# 2399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10694# 2415 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10695 end do
10696 end do
10697 end do
10698
10699# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10700#if defined(MFC_OpenACC)
10701# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10702!$acc end parallel loop
10703# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10704#elif defined(MFC_OpenMP)
10705# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10706
10707# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10708!$omp end target teams loop
10709# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10710#endif
10711 else if (model_eqns == 2 .and. bubbles_euler) then
10712 ! 5-equation model with Euler-Euler bubble dynamics
10713
10714# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10715
10716# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10717#if defined(MFC_OpenACC)
10718# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10719!$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)
10720# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10721#elif defined(MFC_OpenMP)
10722# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10723
10724# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10725
10726# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10727
10728# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10729!$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)
10730# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10731#endif
10732# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10733 do l = is3%beg, is3%end
10734 do k = is2%beg, is2%end
10735 do j = is1%beg, is1%end
10736 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10737 rho_l = 0._wp; rho_r = 0._wp
10738 gamma_l = 0._wp; gamma_r = 0._wp
10739 pi_inf_l = 0._wp; pi_inf_r = 0._wp
10740 qv_l = 0._wp; qv_r = 0._wp
10741
10742
10743# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10744#if defined(MFC_OpenACC)
10745# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10746!$acc loop seq
10747# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10748#elif defined(MFC_OpenMP)
10749# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10750
10751# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10752#endif
10753 do i = 1, num_fluids
10754 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
10755 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
10756 end do
10757
10758 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10759
10760
10761# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10762#if defined(MFC_OpenACC)
10763# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10764!$acc loop seq
10765# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10766#elif defined(MFC_OpenMP)
10767# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10768
10769# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10770#endif
10771 do i = 1, num_dims
10772 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
10773 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
10774 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
10775 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
10776 end do
10777
10778 ! Retain this in the refactor
10779 if (mpp_lim .and. (num_fluids > 2)) then
10780
10781# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10782#if defined(MFC_OpenACC)
10783# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10784!$acc loop seq
10785# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10786#elif defined(MFC_OpenMP)
10787# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10788
10789# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10790#endif
10791 do i = 1, num_fluids
10792 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
10793 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*gammas(i)
10794 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*pi_infs(i)
10795 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
10796 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
10797 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*gammas(i)
10798 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
10799 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
10800 end do
10801 else if (num_fluids > 2) then
10802
10803# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10804#if defined(MFC_OpenACC)
10805# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10806!$acc loop seq
10807# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10808#elif defined(MFC_OpenMP)
10809# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10810
10811# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10812#endif
10813 do i = 1, num_fluids - 1
10814 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
10815 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*gammas(i)
10816 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*pi_infs(i)
10817 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
10818 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
10819 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*gammas(i)
10820 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
10821 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
10822 end do
10823 else
10824 rho_l = ql_prim_rsy_vf(j, k, l, 1)
10825 gamma_l = gammas(1)
10826 pi_inf_l = pi_infs(1)
10827 qv_l = qvs(1)
10828 rho_r = qr_prim_rsy_vf(j + 1, k, l, 1)
10829 gamma_r = gammas(1)
10830 pi_inf_r = pi_infs(1)
10831 qv_r = qvs(1)
10832 end if
10833
10834 if (viscous) then
10835 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
10836
10837# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10838#if defined(MFC_OpenACC)
10839# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10840!$acc loop seq
10841# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10842#elif defined(MFC_OpenMP)
10843# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10844
10845# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10846#endif
10847 do i = 1, 2
10848 re_l(i) = dflt_real
10849 re_r(i) = dflt_real
10850
10851 if (re_size(i) > 0) re_l(i) = 0._wp
10852 if (re_size(i) > 0) re_r(i) = 0._wp
10853
10854
10855# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10856#if defined(MFC_OpenACC)
10857# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10858!$acc loop seq
10859# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10860#elif defined(MFC_OpenMP)
10861# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10862
10863# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10864#endif
10865 do q = 1, re_size(i)
10866 re_l(i) = (1._wp - ql_prim_rsy_vf(j, k, l, e_idx + re_idx(i, q)))/res_gs(i, &
10867 & q) + re_l(i)
10868 re_r(i) = (1._wp - qr_prim_rsy_vf(j + 1, k, l, e_idx + re_idx(i, &
10869 & q)))/res_gs(i, q) + re_r(i)
10870 end do
10871
10872 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
10873 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
10874 end do
10875 end if
10876 end if
10877
10878 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
10879 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
10880
10881 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
10882 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
10883
10884 h_l = (e_l + pres_l)/rho_l
10885 h_r = (e_r + pres_r)/rho_r
10886
10887 if (avg_state == 2) then
10888
10889# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10890#if defined(MFC_OpenACC)
10891# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10892!$acc loop seq
10893# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10894#elif defined(MFC_OpenMP)
10895# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10896
10897# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10898#endif
10899 do i = 1, nb
10900 r0_l(i) = ql_prim_rsy_vf(j, k, l, rs(i))
10901 r0_r(i) = qr_prim_rsy_vf(j + 1, k, l, rs(i))
10902
10903 v0_l(i) = ql_prim_rsy_vf(j, k, l, vs(i))
10904 v0_r(i) = qr_prim_rsy_vf(j + 1, k, l, vs(i))
10905 if (.not. polytropic .and. .not. qbmm) then
10906 p0_l(i) = ql_prim_rsy_vf(j, k, l, ps(i))
10907 p0_r(i) = qr_prim_rsy_vf(j + 1, k, l, ps(i))
10908 end if
10909 end do
10910
10911 if (.not. qbmm) then
10912 if (adv_n) then
10913 nbub_l = ql_prim_rsy_vf(j, k, l, n_idx)
10914 nbub_r = qr_prim_rsy_vf(j + 1, k, l, n_idx)
10915 else
10916 nbub_l = 0._wp
10917 nbub_r = 0._wp
10918
10919# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10920#if defined(MFC_OpenACC)
10921# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10922!$acc loop seq
10923# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10924#elif defined(MFC_OpenMP)
10925# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10926
10927# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10928#endif
10929 do i = 1, nb
10930 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
10931 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
10932 end do
10933
10934 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsy_vf(j, k, l, e_idx + num_fluids)/nbub_l
10935 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsy_vf(j + 1, k, l, e_idx + num_fluids)/nbub_r
10936 end if
10937 else
10938 ! nb stored in 0th moment of first R0 bin in variable conversion module
10939 nbub_l = ql_prim_rsy_vf(j, k, l, bubxb)
10940 nbub_r = qr_prim_rsy_vf(j + 1, k, l, bubxb)
10941 end if
10942
10943
10944# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10945#if defined(MFC_OpenACC)
10946# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10947!$acc loop seq
10948# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10949#elif defined(MFC_OpenMP)
10950# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10951
10952# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10953#endif
10954 do i = 1, nb
10955 if (.not. qbmm) then
10956 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
10957 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
10958 end if
10959 end do
10960
10961 if (qbmm) then
10962 pbwr3lbar = mom_sp_rsy_vf(j, k, l, 4)
10963 pbwr3rbar = mom_sp_rsy_vf(j + 1, k, l, 4)
10964
10965 r3lbar = mom_sp_rsy_vf(j, k, l, 1)
10966 r3rbar = mom_sp_rsy_vf(j + 1, k, l, 1)
10967
10968 r3v2lbar = mom_sp_rsy_vf(j, k, l, 3)
10969 r3v2rbar = mom_sp_rsy_vf(j + 1, k, l, 3)
10970 else
10971 pbwr3lbar = 0._wp
10972 pbwr3rbar = 0._wp
10973
10974 r3lbar = 0._wp
10975 r3rbar = 0._wp
10976
10977 r3v2lbar = 0._wp
10978 r3v2rbar = 0._wp
10979
10980
10981# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10982#if defined(MFC_OpenACC)
10983# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10984!$acc loop seq
10985# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10986#elif defined(MFC_OpenMP)
10987# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10988
10989# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10990#endif
10991 do i = 1, nb
10992 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
10993 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
10994
10995 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
10996 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
10997
10998 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
10999 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
11000 end do
11001 end if
11002
11003 rho_avg = 5.e-1_wp*(rho_l + rho_r)
11004 h_avg = 5.e-1_wp*(h_l + h_r)
11005 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
11006 qv_avg = 5.e-1_wp*(qv_l + qv_r)
11007 vel_avg_rms = 0._wp
11008
11009
11010# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11011#if defined(MFC_OpenACC)
11012# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11013!$acc loop seq
11014# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11015#elif defined(MFC_OpenMP)
11016# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11017
11018# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11019#endif
11020 do i = 1, num_dims
11021 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
11022 end do
11023 end if
11024
11025 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
11026 & c_l, qv_l)
11027
11028 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
11029 & c_r, qv_r)
11030
11031 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
11032 ! variables are placeholders to call the subroutine.
11033 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
11034 & 0._wp, c_avg, qv_avg)
11035
11036 if (viscous) then
11037
11038# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11039#if defined(MFC_OpenACC)
11040# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11041!$acc loop seq
11042# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11043#elif defined(MFC_OpenMP)
11044# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11045
11046# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11047#endif
11048 do i = 1, 2
11049 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
11050 end do
11051 end if
11052
11053 ! Low Mach correction
11054 if (low_mach == 2) then
11055 if (riemann_solver == 1 .or. riemann_solver == 5) then
11056# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11057 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11058# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11059 pcorr = 0._wp
11060# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11061
11062# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11063 if (low_mach == 1) then
11064# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11065 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
11066# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11067 end if
11068# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11069 else if (riemann_solver == 2) then
11070# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11071 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11072# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11073 pcorr = 0._wp
11074# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11075
11076# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11077 if (low_mach == 1) then
11078# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11079 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))) &
11080# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11081 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
11082# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11083 else if (low_mach == 2) then
11084# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11085 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))))
11086# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11087 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))))
11088# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11089 vel_l(dir_idx(1)) = vel_l_tmp
11090# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11091 vel_r(dir_idx(1)) = vel_r_tmp
11092# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11093 end if
11094# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11095 end if
11096 end if
11097
11098 if (wave_speeds == 1) then
11099 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
11100 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
11101
11102 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
11103 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
11104 & - rho_r*(s_r - vel_r(dir_idx(1))))
11105 else if (wave_speeds == 2) then
11106 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
11107
11108 pres_sr = pres_sl
11109
11110 ! Low Mach correction: Thornber et al. JCP (2008)
11111 ms_l = max(1._wp, &
11112 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
11113 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
11114 ms_r = max(1._wp, &
11115 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
11116 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
11117
11118 s_l = vel_l(dir_idx(1)) - c_l*ms_l
11119 s_r = vel_r(dir_idx(1)) + c_r*ms_r
11120
11121 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
11122 end if
11123
11124 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
11125 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
11126
11127 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
11128 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
11129 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
11130
11131 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
11132 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
11133 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
11134
11135 ! Low Mach correction
11136 if (low_mach == 1) then
11137 if (riemann_solver == 1 .or. riemann_solver == 5) then
11138# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11139 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11140# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11141 pcorr = 0._wp
11142# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11143
11144# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11145 if (low_mach == 1) then
11146# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11147 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
11148# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11149 end if
11150# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11151 else if (riemann_solver == 2) then
11152# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11153 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11154# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11155 pcorr = 0._wp
11156# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11157
11158# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11159 if (low_mach == 1) then
11160# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11161 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))) &
11162# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11163 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
11164# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11165 else if (low_mach == 2) then
11166# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11167 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))))
11168# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11169 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))))
11170# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11171 vel_l(dir_idx(1)) = vel_l_tmp
11172# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11173 vel_r(dir_idx(1)) = vel_r_tmp
11174# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11175 end if
11176# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11177 end if
11178 else
11179 pcorr = 0._wp
11180 end if
11181
11182
11183# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11184#if defined(MFC_OpenACC)
11185# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11186!$acc loop seq
11187# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11188#elif defined(MFC_OpenMP)
11189# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11190
11191# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11192#endif
11193 do i = 1, contxe
11194 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
11195 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsy_vf(j &
11196 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11197 end do
11198
11199 if (bubbles_euler .and. (num_fluids > 1)) then
11200 ! Kill mass transport @ gas density
11201 flux_rsy_vf(j, k, l, contxe) = 0._wp
11202 end if
11203
11204 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
11205
11206 ! Include p_tilde
11207
11208 if (avg_state == 2) then
11209 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
11210 pres_l = pres_l - alpha_l(num_fluids)*pres_l
11211 else
11212 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
11213 end if
11214
11215 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
11216 pres_r = pres_r - alpha_r(num_fluids)*pres_r
11217 else
11218 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
11219 end if
11220 end if
11221
11222
11223# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11224#if defined(MFC_OpenACC)
11225# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11226!$acc loop seq
11227# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11228#elif defined(MFC_OpenMP)
11229# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11230
11231# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11232#endif
11233 do i = 1, num_dims
11234 flux_rsy_vf(j, k, l, &
11235 & contxe + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
11236 & + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
11237 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
11238 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
11239 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
11240 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
11241 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
11242 end do
11243
11244 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
11245 flux_rsy_vf(j, k, l, &
11246 & e_idx) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
11247 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
11248 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s &
11249 & - vel_r(dir_idx(1)))*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) &
11250 & + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
11251
11252 ! Volume fraction flux
11253
11254# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11255#if defined(MFC_OpenACC)
11256# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11257!$acc loop seq
11258# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11259#elif defined(MFC_OpenMP)
11260# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11261
11262# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11263#endif
11264 do i = advxb, advxe
11265 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
11266 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsy_vf(j &
11267 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11268 end do
11269
11270 ! Advection velocity source: interface velocity for volume fraction transport
11271
11272# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11273#if defined(MFC_OpenACC)
11274# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11275!$acc loop seq
11276# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11277#elif defined(MFC_OpenMP)
11278# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11279
11280# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11281#endif
11282 do i = 1, num_dims
11283 vel_src_rsy_vf(j, k, l, &
11284 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*(xi_l &
11285 & - 1._wp)) + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*(xi_r &
11286 & - 1._wp))
11287
11288 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
11289 end do
11290
11291 flux_src_rsy_vf(j, k, l, advxb) = vel_src_rsy_vf(j, k, l, dir_idx(1))
11292
11293 ! Add advection flux for bubble variables
11294
11295# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11296#if defined(MFC_OpenACC)
11297# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11298!$acc loop seq
11299# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11300#elif defined(MFC_OpenMP)
11301# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11302
11303# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11304#endif
11305 do i = bubxb, bubxe
11306 flux_rsy_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsy_vf(j, k, l, &
11307 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
11308 & + xi_p*nbub_r*qr_prim_rsy_vf(j + 1, k, l, &
11309 & i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11310 end do
11311
11312 if (qbmm) then
11313 flux_rsy_vf(j, k, l, &
11314 & bubxb) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
11315 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11316 end if
11317
11318 if (adv_n) then
11319 flux_rsy_vf(j, k, l, &
11320 & n_idx) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
11321 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11322 end if
11323
11324 ! Geometrical source flux for cylindrical coordinates
11325# 2772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11326 if (cyl_coord) then
11327 ! Substituting the advective flux into the inviscid geometrical source flux
11328
11329# 2774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11330#if defined(MFC_OpenACC)
11331# 2774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11332!$acc loop seq
11333# 2774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11334#elif defined(MFC_OpenMP)
11335# 2774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11336
11337# 2774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11338#endif
11339 do i = 1, e_idx
11340 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
11341 end do
11342 ! Recalculating the radial momentum geometric source flux
11343 flux_gsrc_rsy_vf(j, k, l, &
11344 & contxe + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
11345 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
11346 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
11347 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
11348 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp &
11349 & - dir_flg(dir_idx(1)))*vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
11350 ! Geometrical source of the void fraction(s) is zero
11351
11352# 2787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11353#if defined(MFC_OpenACC)
11354# 2787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11355!$acc loop seq
11356# 2787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11357#elif defined(MFC_OpenMP)
11358# 2787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11359
11360# 2787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11361#endif
11362 do i = advxb, advxe
11363 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
11364 end do
11365 end if
11366# 2793 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11367# 2810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11368 end do
11369 end do
11370 end do
11371
11372# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11373#if defined(MFC_OpenACC)
11374# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11375!$acc end parallel loop
11376# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11377#elif defined(MFC_OpenMP)
11378# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11379
11380# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11381!$omp end target teams loop
11382# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11383#endif
11384 else
11385 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
11386
11387# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11388
11389# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11390#if defined(MFC_OpenACC)
11391# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11392!$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)
11393# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11394#elif defined(MFC_OpenMP)
11395# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11396
11397# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11398
11399# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11400
11401# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11402!$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)
11403# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11404#endif
11405# 2824 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11406 do l = is3%beg, is3%end
11407 do k = is2%beg, is2%end
11408 do j = is1%beg, is1%end
11409 vel_l_rms = 0._wp; vel_r_rms = 0._wp
11410 rho_l = 0._wp; rho_r = 0._wp
11411 gamma_l = 0._wp; gamma_r = 0._wp
11412 pi_inf_l = 0._wp; pi_inf_r = 0._wp
11413 qv_l = 0._wp; qv_r = 0._wp
11414 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
11415
11416
11417# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11418#if defined(MFC_OpenACC)
11419# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11420!$acc loop seq
11421# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11422#elif defined(MFC_OpenMP)
11423# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11424
11425# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11426#endif
11427 do i = 1, num_fluids
11428 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
11429 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
11430 end do
11431
11432
11433# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11434#if defined(MFC_OpenACC)
11435# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11436!$acc loop seq
11437# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11438#elif defined(MFC_OpenMP)
11439# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11440
11441# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11442#endif
11443 do i = 1, num_dims
11444 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
11445 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
11446 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
11447 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
11448 end do
11449
11450 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
11451 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
11452
11453 ! Change this by splitting it into the cases present in the bubbles_euler
11454 if (mpp_lim) then
11455
11456# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11457#if defined(MFC_OpenACC)
11458# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11459!$acc loop seq
11460# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11461#elif defined(MFC_OpenMP)
11462# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11463
11464# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11465#endif
11466 do i = 1, num_fluids
11467 ql_prim_rsy_vf(j, k, l, i) = max(0._wp, ql_prim_rsy_vf(j, k, l, i))
11468 ql_prim_rsy_vf(j, k, l, e_idx + i) = min(max(0._wp, ql_prim_rsy_vf(j, k, l, &
11469 & e_idx + i)), 1._wp)
11470 qr_prim_rsy_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsy_vf(j + 1, k, l, i))
11471 qr_prim_rsy_vf(j + 1, k, l, e_idx + i) = min(max(0._wp, qr_prim_rsy_vf(j + 1, &
11472 & k, l, e_idx + i)), 1._wp)
11473 alpha_l_sum = alpha_l_sum + ql_prim_rsy_vf(j, k, l, e_idx + i)
11474 alpha_r_sum = alpha_r_sum + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
11475 end do
11476
11477
11478# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11479#if defined(MFC_OpenACC)
11480# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11481!$acc loop seq
11482# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11483#elif defined(MFC_OpenMP)
11484# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11485
11486# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11487#endif
11488 do i = 1, num_fluids
11489 ql_prim_rsy_vf(j, k, l, e_idx + i) = ql_prim_rsy_vf(j, k, l, &
11490 & e_idx + i)/max(alpha_l_sum, sgm_eps)
11491 qr_prim_rsy_vf(j + 1, k, l, e_idx + i) = qr_prim_rsy_vf(j + 1, k, l, &
11492 & e_idx + i)/max(alpha_r_sum, sgm_eps)
11493 end do
11494 end if
11495
11496
11497# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11498#if defined(MFC_OpenACC)
11499# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11500!$acc loop seq
11501# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11502#elif defined(MFC_OpenMP)
11503# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11504
11505# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11506#endif
11507 do i = 1, num_fluids
11508 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
11509 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*gammas(i)
11510 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*pi_infs(i)
11511 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
11512
11513 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
11514 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*gammas(i)
11515 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
11516 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
11517 end do
11518
11519 re_max = 0
11520 if (re_size(1) > 0) re_max = 1
11521 if (re_size(2) > 0) re_max = 2
11522
11523 if (viscous) then
11524
11525# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11526#if defined(MFC_OpenACC)
11527# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11528!$acc loop seq
11529# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11530#elif defined(MFC_OpenMP)
11531# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11532
11533# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11534#endif
11535 do i = 1, re_max
11536 re_l(i) = 0._wp
11537 re_r(i) = 0._wp
11538
11539
11540# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11541#if defined(MFC_OpenACC)
11542# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11543!$acc loop seq
11544# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11545#elif defined(MFC_OpenMP)
11546# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11547
11548# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11549#endif
11550 do q = 1, re_size(i)
11551 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
11552 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
11553 end do
11554
11555 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
11556 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
11557 end do
11558 end if
11559
11560 if (chemistry) then
11561 c_sum_yi_phi = 0.0_wp
11562
11563# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11564#if defined(MFC_OpenACC)
11565# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11566!$acc loop seq
11567# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11568#elif defined(MFC_OpenMP)
11569# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11570
11571# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11572#endif
11573 do i = chemxb, chemxe
11574 ys_l(i - chemxb + 1) = ql_prim_rsy_vf(j, k, l, i)
11575 ys_r(i - chemxb + 1) = qr_prim_rsy_vf(j + 1, k, l, i)
11576 end do
11577
11578 call get_mixture_molecular_weight(ys_l, mw_l)
11579 call get_mixture_molecular_weight(ys_r, mw_r)
11580
11581# 2923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11582 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
11583 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
11584# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11585
11586 r_gas_l = gas_constant/mw_l
11587 r_gas_r = gas_constant/mw_r
11588
11589 t_l = pres_l/rho_l/r_gas_l
11590 t_r = pres_r/rho_r/r_gas_r
11591
11592 call get_species_specific_heats_r(t_l, cp_il)
11593 call get_species_specific_heats_r(t_r, cp_ir)
11594
11595 if (chem_params%gamma_method == 1) then
11596 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
11597 gamma_il = cp_il/(cp_il - 1.0_wp)
11598 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
11599
11600 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
11601 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
11602 else if (chem_params%gamma_method == 2) then
11603 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
11604 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
11605 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
11606 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
11607 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
11608
11609 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
11610 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
11611 end if
11612
11613 call get_mixture_energy_mass(t_l, ys_l, e_l)
11614 call get_mixture_energy_mass(t_r, ys_r, e_r)
11615
11616 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
11617 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
11618 h_l = (e_l + pres_l)/rho_l
11619 h_r = (e_r + pres_r)/rho_r
11620 else
11621 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
11622 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
11623
11624 h_l = (e_l + pres_l)/rho_l
11625 h_r = (e_r + pres_r)/rho_r
11626 end if
11627
11628 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
11629 if (hypoelasticity) then
11630
11631# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11632#if defined(MFC_OpenACC)
11633# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11634!$acc loop seq
11635# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11636#elif defined(MFC_OpenMP)
11637# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11638
11639# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11640#endif
11641 do i = 1, strxe - strxb + 1
11642 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
11643 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
11644 end do
11645 g_l = 0._wp
11646 g_r = 0._wp
11647
11648# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11649#if defined(MFC_OpenACC)
11650# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11651!$acc loop seq
11652# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11653#elif defined(MFC_OpenMP)
11654# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11655
11656# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11657#endif
11658 do i = 1, num_fluids
11659 g_l = g_l + alpha_l(i)*gs_rs(i)
11660 g_r = g_r + alpha_r(i)*gs_rs(i)
11661 end do
11662
11663# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11664#if defined(MFC_OpenACC)
11665# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11666!$acc loop seq
11667# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11668#elif defined(MFC_OpenMP)
11669# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11670
11671# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11672#endif
11673 do i = 1, strxe - strxb + 1
11674 ! Elastic contribution to energy if G large enough
11675 if ((g_l > verysmall) .and. (g_r > verysmall)) then
11676 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
11677 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
11678 ! Additional terms in 2D and 3D
11679 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
11680 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
11681 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
11682 end if
11683 end if
11684 end do
11685 end if
11686
11687 ! Hyperelastic stress contribution: strain energy added to total energy
11688 if (hyperelasticity) then
11689
11690# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11691#if defined(MFC_OpenACC)
11692# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11693!$acc loop seq
11694# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11695#elif defined(MFC_OpenMP)
11696# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11697
11698# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11699#endif
11700 do i = 1, num_dims
11701 xi_field_l(i) = ql_prim_rsy_vf(j, k, l, xibeg - 1 + i)
11702 xi_field_r(i) = qr_prim_rsy_vf(j + 1, k, l, xibeg - 1 + i)
11703 end do
11704 g_l = 0._wp
11705 g_r = 0._wp
11706
11707# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11708#if defined(MFC_OpenACC)
11709# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11710!$acc loop seq
11711# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11712#elif defined(MFC_OpenMP)
11713# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11714
11715# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11716#endif
11717 do i = 1, num_fluids
11718 ! Mixture left and right shear modulus
11719 g_l = g_l + alpha_l(i)*gs_rs(i)
11720 g_r = g_r + alpha_r(i)*gs_rs(i)
11721 end do
11722 ! Elastic contribution to energy if G large enough
11723 if (g_l > verysmall .and. g_r > verysmall) then
11724 e_l = e_l + g_l*ql_prim_rsy_vf(j, k, l, xiend + 1)
11725 e_r = e_r + g_r*qr_prim_rsy_vf(j + 1, k, l, xiend + 1)
11726 end if
11727
11728# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11729#if defined(MFC_OpenACC)
11730# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11731!$acc loop seq
11732# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11733#elif defined(MFC_OpenMP)
11734# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11735
11736# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11737#endif
11738 do i = 1, b_size - 1
11739 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
11740 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
11741 end do
11742 end if
11743
11744 h_l = (e_l + pres_l)/rho_l
11745 h_r = (e_r + pres_r)/rho_r
11746
11747 if (avg_state == 1) then
11748# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11749 rho_avg = sqrt(rho_l*rho_r)
11750# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11751
11752# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11753 vel_avg_rms = 0._wp
11754# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11755
11756# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11757
11758# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11759#if defined(MFC_OpenACC)
11760# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11761!$acc loop seq
11762# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11763#elif defined(MFC_OpenMP)
11764# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11765
11766# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11767#endif
11768# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11769 do i = 1, num_vels
11770# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11771 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
11772# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11773 end do
11774# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11775
11776# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11777 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
11778# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11779
11780# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11781 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
11782# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11783
11784# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11785 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
11786# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11787
11788# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11789 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
11790# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11791
11792# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11793 if (chemistry) then
11794# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11795 eps = 0.001_wp
11796# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11797 call get_species_enthalpies_rt(t_l, h_il)
11798# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11799 call get_species_enthalpies_rt(t_r, h_ir)
11800# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11801 h_il = h_il*gas_constant/molecular_weights*t_l
11802# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11803 h_ir = h_ir*gas_constant/molecular_weights*t_r
11804# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11805 call get_species_specific_heats_r(t_l, cp_il)
11806# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11807 call get_species_specific_heats_r(t_r, cp_ir)
11808# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11809
11810# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11811 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
11812# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11813 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
11814# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11815 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
11816# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11817 if (abs(t_l - t_r) < eps) then
11818# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11819 ! Case when T_L and T_R are very close
11820# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11821 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
11822# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11823 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
11824# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11825 & - gas_constant/molecular_weights(:)))
11826# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11827 else
11828# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11829 ! Normal calculation when T_L and T_R are sufficiently different
11830# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11831 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
11832# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11833 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
11834# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11835 end if
11836# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11837 gamma_avg = cp_avg/cv_avg
11838# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11839
11840# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11841 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
11842# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11843 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
11844# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11845 end if
11846# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11847 end if
11848# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11849
11850# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11851 if (avg_state == 2) then
11852# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11853 rho_avg = 5.e-1_wp*(rho_l + rho_r)
11854# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11855 vel_avg_rms = 0._wp
11856# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11857
11858# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11859#if defined(MFC_OpenACC)
11860# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11861!$acc loop seq
11862# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11863#elif defined(MFC_OpenMP)
11864# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11865
11866# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11867#endif
11868# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11869 do i = 1, num_vels
11870# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11871 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
11872# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11873 end do
11874# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11875
11876# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11877 h_avg = 5.e-1_wp*(h_l + h_r)
11878# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11879 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
11880# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11881 qv_avg = 5.e-1_wp*(qv_l + qv_r)
11882# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11883 end if
11884
11885 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
11886 & c_l, qv_l)
11887
11888 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
11889 & c_r, qv_r)
11890
11891 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
11892 ! variables are placeholders to call the subroutine.
11893 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
11894 & c_sum_yi_phi, c_avg, qv_avg)
11895
11896 if (viscous) then
11897 if (chemistry) then
11898 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
11899 end if
11900
11901# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11902#if defined(MFC_OpenACC)
11903# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11904!$acc loop seq
11905# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11906#elif defined(MFC_OpenMP)
11907# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11908
11909# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11910#endif
11911 do i = 1, 2
11912 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
11913 end do
11914 end if
11915
11916 ! Low Mach correction
11917 if (low_mach == 2) then
11918 if (riemann_solver == 1 .or. riemann_solver == 5) then
11919# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11920 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11921# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11922 pcorr = 0._wp
11923# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11924
11925# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11926 if (low_mach == 1) then
11927# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11928 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
11929# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11930 end if
11931# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11932 else if (riemann_solver == 2) then
11933# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11934 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11935# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11936 pcorr = 0._wp
11937# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11938
11939# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11940 if (low_mach == 1) then
11941# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11942 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))) &
11943# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11944 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
11945# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11946 else if (low_mach == 2) then
11947# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11948 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))))
11949# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11950 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))))
11951# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11952 vel_l(dir_idx(1)) = vel_l_tmp
11953# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11954 vel_r(dir_idx(1)) = vel_r_tmp
11955# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11956 end if
11957# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11958 end if
11959 end if
11960
11961 if (wave_speeds == 1) then
11962 if (elasticity) then
11963 ! Elastic wave speed, Rodriguez et al. JCP (2019)
11964 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) &
11965 & ))/rho_l), &
11966 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
11967 & + tau_e_r(dir_idx_tau(1)))/rho_r))
11968 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) &
11969 & ))/rho_r), &
11970 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
11971 & + tau_e_l(dir_idx_tau(1)))/rho_l))
11972 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
11973 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
11974 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
11975 & - vel_r(dir_idx(1))))
11976 else
11977 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
11978 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
11979 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
11980 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
11981 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
11982 end if
11983 else if (wave_speeds == 2) then
11984 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
11985
11986 pres_sr = pres_sl
11987
11988 ! Low Mach correction: Thornber et al. JCP (2008)
11989 ms_l = max(1._wp, &
11990 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
11991 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
11992 ms_r = max(1._wp, &
11993 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
11994 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
11995
11996 s_l = vel_l(dir_idx(1)) - c_l*ms_l
11997 s_r = vel_r(dir_idx(1)) + c_r*ms_r
11998
11999 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
12000 end if
12001
12002 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
12003 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
12004
12005 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
12006 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
12007 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
12008
12009 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
12010 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
12011 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
12012
12013 ! Low Mach correction
12014 if (low_mach == 1) then
12015 if (riemann_solver == 1 .or. riemann_solver == 5) then
12016# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12017 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12018# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12019 pcorr = 0._wp
12020# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12021
12022# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12023 if (low_mach == 1) then
12024# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12025 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12026# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12027 end if
12028# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12029 else if (riemann_solver == 2) then
12030# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12031 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12032# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12033 pcorr = 0._wp
12034# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12035
12036# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12037 if (low_mach == 1) then
12038# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12039 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))) &
12040# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12041 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
12042# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12043 else if (low_mach == 2) then
12044# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12045 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))))
12046# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12047 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))))
12048# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12049 vel_l(dir_idx(1)) = vel_l_tmp
12050# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12051 vel_r(dir_idx(1)) = vel_r_tmp
12052# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12053 end if
12054# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12055 end if
12056 else
12057 pcorr = 0._wp
12058 end if
12059
12060 ! COMPUTING THE HLLC FLUXES MASS FLUX.
12061
12062# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12063#if defined(MFC_OpenACC)
12064# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12065!$acc loop seq
12066# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12067#elif defined(MFC_OpenMP)
12068# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12069
12070# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12071#endif
12072 do i = 1, contxe
12073 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
12074 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsy_vf(j &
12075 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12076 end do
12077
12078 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
12079
12080# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12081#if defined(MFC_OpenACC)
12082# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12083!$acc loop seq
12084# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12085#elif defined(MFC_OpenMP)
12086# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12087
12088# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12089#endif
12090 do i = 1, num_dims
12091 flux_rsy_vf(j, k, l, &
12092 & contxe + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
12093 & + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
12094 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
12095 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
12096 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
12097 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
12098 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
12099 end do
12100
12101 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
12102 flux_rsy_vf(j, k, l, &
12103 & e_idx) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
12104 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1))))) - e_l)) &
12105 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s &
12106 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r)) &
12107 & + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
12108
12109 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
12110 if (elasticity) then
12111 flux_ene_e = 0._wp
12112
12113# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12114#if defined(MFC_OpenACC)
12115# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12116!$acc loop seq
12117# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12118#elif defined(MFC_OpenMP)
12119# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12120
12121# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12122#endif
12123 do i = 1, num_dims
12124 ! MOMENTUM ELASTIC FLUX.
12125 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = flux_rsy_vf(j, k, l, &
12126 & contxe + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
12127 & - xi_p*tau_e_r(dir_idx_tau(i))
12128 ! ENERGY ELASTIC FLUX.
12129 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
12130 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
12131 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
12132 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
12133 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
12134 end do
12135 flux_rsy_vf(j, k, l, e_idx) = flux_rsy_vf(j, k, l, e_idx) + flux_ene_e
12136 end if
12137
12138 ! HYPOELASTIC STRESS EVOLUTION FLUX.
12139 if (hypoelasticity) then
12140
12141# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12142#if defined(MFC_OpenACC)
12143# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12144!$acc loop seq
12145# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12146#elif defined(MFC_OpenMP)
12147# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12148
12149# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12150#endif
12151 do i = 1, strxe - strxb + 1
12152 flux_rsy_vf(j, k, l, &
12153 & strxb - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
12154 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
12155 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
12156 end do
12157 end if
12158
12159 ! VOLUME FRACTION FLUX.
12160
12161# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12162#if defined(MFC_OpenACC)
12163# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12164!$acc loop seq
12165# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12166#elif defined(MFC_OpenMP)
12167# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12168
12169# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12170#endif
12171 do i = advxb, advxe
12172 flux_rsy_vf(j, k, l, i) = xi_m*ql_prim_rsy_vf(j, k, l, &
12173 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsy_vf(j &
12174 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12175 end do
12176
12177 ! VOLUME FRACTION SOURCE FLUX.
12178
12179# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12180#if defined(MFC_OpenACC)
12181# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12182!$acc loop seq
12183# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12184#elif defined(MFC_OpenMP)
12185# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12186
12187# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12188#endif
12189 do i = 1, num_dims
12190 vel_src_rsy_vf(j, k, l, &
12191 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*(xi_l &
12192 & - 1._wp)) + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*(xi_r &
12193 & - 1._wp))
12194 end do
12195
12196 ! COLOR FUNCTION FLUX
12197 if (surface_tension) then
12198 flux_rsy_vf(j, k, l, c_idx) = xi_m*ql_prim_rsy_vf(j, k, l, &
12199 & c_idx)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12200 & + xi_p*qr_prim_rsy_vf(j + 1, k, l, &
12201 & c_idx)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12202 end if
12203
12204 ! Hyperelastic reference map flux for material deformation tracking
12205 if (hyperelasticity) then
12206
12207# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12208#if defined(MFC_OpenACC)
12209# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12210!$acc loop seq
12211# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12212#elif defined(MFC_OpenMP)
12213# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12214
12215# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12216#endif
12217 do i = 1, num_dims
12218 flux_rsy_vf(j, k, l, &
12219 & xibeg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
12220 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
12221 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
12222 end do
12223 end if
12224
12225 flux_src_rsy_vf(j, k, l, advxb) = vel_src_rsy_vf(j, k, l, dir_idx(1))
12226
12227 if (chemistry) then
12228
12229# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12230#if defined(MFC_OpenACC)
12231# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12232!$acc loop seq
12233# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12234#elif defined(MFC_OpenMP)
12235# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12236
12237# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12238#endif
12239 do i = chemxb, chemxe
12240 y_l = ql_prim_rsy_vf(j, k, l, i)
12241 y_r = qr_prim_rsy_vf(j + 1, k, l, i)
12242
12243 flux_rsy_vf(j, k, l, &
12244 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12245 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12246 flux_src_rsy_vf(j, k, l, i) = 0.0_wp
12247 end do
12248 end if
12249
12250 ! Geometrical source flux for cylindrical coordinates
12251# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12252 if (cyl_coord) then
12253 ! Substituting the advective flux into the inviscid geometrical source flux
12254
12255# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12256#if defined(MFC_OpenACC)
12257# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12258!$acc loop seq
12259# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12260#elif defined(MFC_OpenMP)
12261# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12262
12263# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12264#endif
12265 do i = 1, e_idx
12266 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
12267 end do
12268 ! Recalculating the radial momentum geometric source flux
12269 flux_gsrc_rsy_vf(j, k, l, &
12270 & contxe + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
12271 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
12272 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
12273 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
12274 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp &
12275 & - dir_flg(dir_idx(1)))*vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
12276 ! Geometrical source of the void fraction(s) is zero
12277
12278# 3242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12279#if defined(MFC_OpenACC)
12280# 3242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12281!$acc loop seq
12282# 3242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12283#elif defined(MFC_OpenMP)
12284# 3242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12285
12286# 3242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12287#endif
12288 do i = advxb, advxe
12289 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
12290 end do
12291 end if
12292# 3248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12293# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12294 end do
12295 end do
12296 end do
12297
12298# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12299#if defined(MFC_OpenACC)
12300# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12301!$acc end parallel loop
12302# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12303#elif defined(MFC_OpenMP)
12304# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12305
12306# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12307!$omp end target teams loop
12308# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12309#endif
12310 end if
12311 end if
12312# 1787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12313 if (norm_dir == 3) then
12314 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
12315 if (model_eqns == 3) then
12316 ! 6-equation model (model_eqns=3): separate phasic internal energies
12317
12318# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12319
12320# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12321#if defined(MFC_OpenACC)
12322# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12323!$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)
12324# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12325#elif defined(MFC_OpenMP)
12326# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12327
12328# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12329
12330# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12331
12332# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12333!$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)
12334# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12335#endif
12336# 1801 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12337 do l = is3%beg, is3%end
12338 do k = is2%beg, is2%end
12339 do j = is1%beg, is1%end
12340 vel_l_rms = 0._wp; vel_r_rms = 0._wp
12341 rho_l = 0._wp; rho_r = 0._wp
12342 gamma_l = 0._wp; gamma_r = 0._wp
12343 pi_inf_l = 0._wp; pi_inf_r = 0._wp
12344 qv_l = 0._wp; qv_r = 0._wp
12345 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
12346
12347
12348# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12349#if defined(MFC_OpenACC)
12350# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12351!$acc loop seq
12352# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12353#elif defined(MFC_OpenMP)
12354# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12355
12356# 1811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12357#endif
12358 do i = 1, num_dims
12359 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
12360 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
12361 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
12362 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
12363 end do
12364
12365 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
12366 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
12367
12368 rho_l = 0._wp
12369 gamma_l = 0._wp
12370 pi_inf_l = 0._wp
12371 qv_l = 0._wp
12372
12373 rho_r = 0._wp
12374 gamma_r = 0._wp
12375 pi_inf_r = 0._wp
12376 qv_r = 0._wp
12377
12378 alpha_l_sum = 0._wp
12379 alpha_r_sum = 0._wp
12380
12381 if (mpp_lim) then
12382
12383# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12384#if defined(MFC_OpenACC)
12385# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12386!$acc loop seq
12387# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12388#elif defined(MFC_OpenMP)
12389# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12390
12391# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12392#endif
12393 do i = 1, num_fluids
12394 ql_prim_rsz_vf(j, k, l, i) = max(0._wp, ql_prim_rsz_vf(j, k, l, i))
12395 ql_prim_rsz_vf(j, k, l, e_idx + i) = min(max(0._wp, ql_prim_rsz_vf(j, k, l, &
12396 & e_idx + i)), 1._wp)
12397 alpha_l_sum = alpha_l_sum + ql_prim_rsz_vf(j, k, l, e_idx + i)
12398 end do
12399
12400
12401# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12402#if defined(MFC_OpenACC)
12403# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12404!$acc loop seq
12405# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12406#elif defined(MFC_OpenMP)
12407# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12408
12409# 1844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12410#endif
12411 do i = 1, num_fluids
12412 qr_prim_rsz_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsz_vf(j + 1, k, l, i))
12413 qr_prim_rsz_vf(j + 1, k, l, e_idx + i) = min(max(0._wp, qr_prim_rsz_vf(j + 1, &
12414 & k, l, e_idx + i)), 1._wp)
12415 alpha_r_sum = alpha_r_sum + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
12416 end do
12417
12418
12419# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12420#if defined(MFC_OpenACC)
12421# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12422!$acc loop seq
12423# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12424#elif defined(MFC_OpenMP)
12425# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12426
12427# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12428#endif
12429 do i = 1, num_fluids
12430 ql_prim_rsz_vf(j, k, l, e_idx + i) = ql_prim_rsz_vf(j, k, l, &
12431 & e_idx + i)/max(alpha_l_sum, sgm_eps)
12432 qr_prim_rsz_vf(j + 1, k, l, e_idx + i) = qr_prim_rsz_vf(j + 1, k, l, &
12433 & e_idx + i)/max(alpha_r_sum, sgm_eps)
12434 end do
12435 end if
12436
12437
12438# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12439#if defined(MFC_OpenACC)
12440# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12441!$acc loop seq
12442# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12443#elif defined(MFC_OpenMP)
12444# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12445
12446# 1861 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12447#endif
12448 do i = 1, num_fluids
12449 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
12450 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*gammas(i)
12451 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*pi_infs(i)
12452 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
12453
12454 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
12455 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*gammas(i)
12456 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
12457 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
12458
12459 alpha_l(i) = ql_prim_rsz_vf(j, k, l, advxb + i - 1)
12460 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, advxb + i - 1)
12461 end do
12462
12463 if (viscous) then
12464
12465# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12466#if defined(MFC_OpenACC)
12467# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12468!$acc loop seq
12469# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12470#elif defined(MFC_OpenMP)
12471# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12472
12473# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12474#endif
12475 do i = 1, 2
12476 re_l(i) = dflt_real
12477 re_r(i) = dflt_real
12478 if (re_size(i) > 0) re_l(i) = 0._wp
12479 if (re_size(i) > 0) re_r(i) = 0._wp
12480
12481# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12482#if defined(MFC_OpenACC)
12483# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12484!$acc loop seq
12485# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12486#elif defined(MFC_OpenMP)
12487# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12488
12489# 1884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12490#endif
12491 do q = 1, re_size(i)
12492 re_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + re_idx(i, q))/res_gs(i, q) + re_l(i)
12493 re_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + re_idx(i, q))/res_gs(i, q) + re_r(i)
12494 end do
12495 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
12496 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
12497 end do
12498 end if
12499
12500 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
12501 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
12502
12503 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
12504 if (hypoelasticity) then
12505
12506# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12507#if defined(MFC_OpenACC)
12508# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12509!$acc loop seq
12510# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12511#elif defined(MFC_OpenMP)
12512# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12513
12514# 1899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12515#endif
12516 do i = 1, strxe - strxb + 1
12517 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
12518 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
12519 end do
12520 g_l = 0._wp; g_r = 0._wp
12521
12522# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12523#if defined(MFC_OpenACC)
12524# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12525!$acc loop seq
12526# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12527#elif defined(MFC_OpenMP)
12528# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12529
12530# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12531#endif
12532 do i = 1, num_fluids
12533 g_l = g_l + alpha_l(i)*gs_rs(i)
12534 g_r = g_r + alpha_r(i)*gs_rs(i)
12535 end do
12536
12537# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12538#if defined(MFC_OpenACC)
12539# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12540!$acc loop seq
12541# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12542#elif defined(MFC_OpenMP)
12543# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12544
12545# 1910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12546#endif
12547 do i = 1, strxe - strxb + 1
12548 ! Elastic contribution to energy if G large enough
12549 if ((g_l > verysmall) .and. (g_r > verysmall)) then
12550 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
12551 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
12552 ! Additional terms in 2D and 3D
12553 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
12554 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
12555 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
12556 end if
12557 end if
12558 end do
12559 end if
12560
12561 ! Hyperelastic stress contribution: strain energy added to total energy
12562 if (hyperelasticity) then
12563
12564# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12565#if defined(MFC_OpenACC)
12566# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12567!$acc loop seq
12568# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12569#elif defined(MFC_OpenMP)
12570# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12571
12572# 1927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12573#endif
12574 do i = 1, num_dims
12575 xi_field_l(i) = ql_prim_rsz_vf(j, k, l, xibeg - 1 + i)
12576 xi_field_r(i) = qr_prim_rsz_vf(j + 1, k, l, xibeg - 1 + i)
12577 end do
12578 g_l = 0._wp; g_r = 0._wp
12579
12580# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12581#if defined(MFC_OpenACC)
12582# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12583!$acc loop seq
12584# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12585#elif defined(MFC_OpenMP)
12586# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12587
12588# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12589#endif
12590 do i = 1, num_fluids
12591 ! Mixture left and right shear modulus
12592 g_l = g_l + alpha_l(i)*gs_rs(i)
12593 g_r = g_r + alpha_r(i)*gs_rs(i)
12594 end do
12595 ! Elastic contribution to energy if G large enough
12596 if (g_l > verysmall .and. g_r > verysmall) then
12597 e_l = e_l + g_l*ql_prim_rsz_vf(j, k, l, xiend + 1)
12598 e_r = e_r + g_r*qr_prim_rsz_vf(j + 1, k, l, xiend + 1)
12599 end if
12600
12601# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12602#if defined(MFC_OpenACC)
12603# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12604!$acc loop seq
12605# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12606#elif defined(MFC_OpenMP)
12607# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12608
12609# 1944 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12610#endif
12611 do i = 1, b_size - 1
12612 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
12613 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
12614 end do
12615 end if
12616
12617 h_l = (e_l + pres_l)/rho_l
12618 h_r = (e_r + pres_r)/rho_r
12619
12620 if (avg_state == 1) then
12621# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12622 rho_avg = sqrt(rho_l*rho_r)
12623# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12624
12625# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12626 vel_avg_rms = 0._wp
12627# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12628
12629# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12630
12631# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12632#if defined(MFC_OpenACC)
12633# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12634!$acc loop seq
12635# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12636#elif defined(MFC_OpenMP)
12637# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12638
12639# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12640#endif
12641# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12642 do i = 1, num_vels
12643# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12644 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
12645# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12646 end do
12647# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12648
12649# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12650 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
12651# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12652
12653# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12654 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
12655# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12656
12657# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12658 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
12659# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12660
12661# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12662 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
12663# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12664
12665# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12666 if (chemistry) then
12667# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12668 eps = 0.001_wp
12669# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12670 call get_species_enthalpies_rt(t_l, h_il)
12671# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12672 call get_species_enthalpies_rt(t_r, h_ir)
12673# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12674 h_il = h_il*gas_constant/molecular_weights*t_l
12675# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12676 h_ir = h_ir*gas_constant/molecular_weights*t_r
12677# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12678 call get_species_specific_heats_r(t_l, cp_il)
12679# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12680 call get_species_specific_heats_r(t_r, cp_ir)
12681# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12682
12683# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12684 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
12685# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12686 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
12687# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12688 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
12689# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12690 if (abs(t_l - t_r) < eps) then
12691# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12692 ! Case when T_L and T_R are very close
12693# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12694 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
12695# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12696 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
12697# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12698 & - gas_constant/molecular_weights(:)))
12699# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12700 else
12701# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12702 ! Normal calculation when T_L and T_R are sufficiently different
12703# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12704 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
12705# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12706 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
12707# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12708 end if
12709# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12710 gamma_avg = cp_avg/cv_avg
12711# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12712
12713# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12714 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
12715# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12716 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
12717# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12718 end if
12719# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12720 end if
12721# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12722
12723# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12724 if (avg_state == 2) then
12725# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12726 rho_avg = 5.e-1_wp*(rho_l + rho_r)
12727# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12728 vel_avg_rms = 0._wp
12729# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12730
12731# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12732#if defined(MFC_OpenACC)
12733# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12734!$acc loop seq
12735# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12736#elif defined(MFC_OpenMP)
12737# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12738
12739# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12740#endif
12741# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12742 do i = 1, num_vels
12743# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12744 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
12745# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12746 end do
12747# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12748
12749# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12750 h_avg = 5.e-1_wp*(h_l + h_r)
12751# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12752 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
12753# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12754 qv_avg = 5.e-1_wp*(qv_l + qv_r)
12755# 1954 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12756 end if
12757
12758 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
12759 & c_l, qv_l)
12760
12761 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
12762 & c_r, qv_r)
12763
12764 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
12765 ! variables are placeholders to call the subroutine.
12766 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
12767 & 0._wp, c_avg, qv_avg)
12768
12769 if (viscous) then
12770
12771# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12772#if defined(MFC_OpenACC)
12773# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12774!$acc loop seq
12775# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12776#elif defined(MFC_OpenMP)
12777# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12778
12779# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12780#endif
12781 do i = 1, 2
12782 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
12783 end do
12784 end if
12785
12786 ! Low Mach correction
12787 if (low_mach == 2) then
12788 if (riemann_solver == 1 .or. riemann_solver == 5) then
12789# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12790 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12791# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12792 pcorr = 0._wp
12793# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12794
12795# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12796 if (low_mach == 1) then
12797# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12798 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12799# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12800 end if
12801# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12802 else if (riemann_solver == 2) then
12803# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12804 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12805# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12806 pcorr = 0._wp
12807# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12808
12809# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12810 if (low_mach == 1) then
12811# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12812 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))) &
12813# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12814 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
12815# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12816 else if (low_mach == 2) then
12817# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12818 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))))
12819# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12820 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))))
12821# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12822 vel_l(dir_idx(1)) = vel_l_tmp
12823# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12824 vel_r(dir_idx(1)) = vel_r_tmp
12825# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12826 end if
12827# 1976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12828 end if
12829 end if
12830
12831 ! COMPUTING THE DIRECT WAVE SPEEDS
12832 if (wave_speeds == 1) then
12833 if (elasticity) then
12834 ! Elastic wave speed, Rodriguez et al. JCP (2019)
12835 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) &
12836 & ))/rho_l), &
12837 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
12838 & + tau_e_r(dir_idx_tau(1)))/rho_r))
12839 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) &
12840 & ))/rho_r), &
12841 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
12842 & + tau_e_l(dir_idx_tau(1)))/rho_l))
12843 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
12844 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
12845 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
12846 & - vel_r(dir_idx(1))))
12847 else
12848 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
12849 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
12850 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
12851 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
12852 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
12853 end if
12854 else if (wave_speeds == 2) then
12855 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
12856
12857 pres_sr = pres_sl
12858
12859 ! Low Mach correction: Thornber et al. JCP (2008)
12860 ms_l = max(1._wp, &
12861 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
12862 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
12863 ms_r = max(1._wp, &
12864 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
12865 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
12866
12867 s_l = vel_l(dir_idx(1)) - c_l*ms_l
12868 s_r = vel_r(dir_idx(1)) + c_r*ms_r
12869
12870 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
12871 end if
12872
12873 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
12874 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
12875
12876 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
12877 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
12878 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
12879
12880 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
12881 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
12882 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
12883
12884 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
12885 xi_mp = -min(0._wp, sign(1._wp, s_l))
12886 xi_pp = max(0._wp, sign(1._wp, s_r))
12887
12888 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 &
12889 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
12890 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
12891 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
12892 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
12893
12894 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))
12895
12896 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 &
12897 & - vel_r(dir_idx(1)))
12898
12899 ! Low Mach correction
12900 if (low_mach == 1) then
12901 if (riemann_solver == 1 .or. riemann_solver == 5) then
12902# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12903 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12904# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12905 pcorr = 0._wp
12906# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12907
12908# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12909 if (low_mach == 1) then
12910# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12911 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12912# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12913 end if
12914# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12915 else if (riemann_solver == 2) then
12916# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12917 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12918# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12919 pcorr = 0._wp
12920# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12921
12922# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12923 if (low_mach == 1) then
12924# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12925 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))) &
12926# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12927 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
12928# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12929 else if (low_mach == 2) then
12930# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12931 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))))
12932# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12933 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))))
12934# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12935 vel_l(dir_idx(1)) = vel_l_tmp
12936# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12937 vel_r(dir_idx(1)) = vel_r_tmp
12938# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12939 end if
12940# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12941 end if
12942 else
12943 pcorr = 0._wp
12944 end if
12945
12946 ! COMPUTING FLUXES MASS FLUX.
12947
12948# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12949#if defined(MFC_OpenACC)
12950# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12951!$acc loop seq
12952# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12953#elif defined(MFC_OpenMP)
12954# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12955
12956# 2055 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12957#endif
12958 do i = 1, contxe
12959 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
12960 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsz_vf(j &
12961 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12962 end do
12963
12964 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
12965
12966# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12967#if defined(MFC_OpenACC)
12968# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12969!$acc loop seq
12970# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12971#elif defined(MFC_OpenMP)
12972# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12973
12974# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12975#endif
12976 do i = 1, num_dims
12977 flux_rsz_vf(j, k, l, &
12978 & contxe + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
12979 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
12980 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l) &
12981 & *(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
12982 end do
12983
12984 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
12985 flux_rsz_vf(j, k, l, e_idx) = (e_star + p_star)*vel_k_star + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
12986
12987 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
12988 if (elasticity) then
12989 flux_ene_e = 0._wp
12990
12991# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12992#if defined(MFC_OpenACC)
12993# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12994!$acc loop seq
12995# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12996#elif defined(MFC_OpenMP)
12997# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12998
12999# 2078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13000#endif
13001 do i = 1, num_dims
13002 ! MOMENTUM ELASTIC FLUX.
13003 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = flux_rsz_vf(j, k, l, &
13004 & contxe + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
13005 & - xi_p*tau_e_r(dir_idx_tau(i))
13006 ! ENERGY ELASTIC FLUX.
13007 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
13008 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
13009 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
13010 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
13011 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
13012 end do
13013 flux_rsz_vf(j, k, l, e_idx) = flux_rsz_vf(j, k, l, e_idx) + flux_ene_e
13014 end if
13015
13016 ! VOLUME FRACTION FLUX.
13017
13018# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13019#if defined(MFC_OpenACC)
13020# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13021!$acc loop seq
13022# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13023#elif defined(MFC_OpenMP)
13024# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13025
13026# 2095 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13027#endif
13028 do i = advxb, advxe
13029 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
13030 & i)*s_s + xi_p*qr_prim_rsz_vf(j + 1, k, l, i)*s_s
13031 end do
13032
13033 ! Advection velocity source: interface velocity for volume fraction transport
13034
13035# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13036#if defined(MFC_OpenACC)
13037# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13038!$acc loop seq
13039# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13040#elif defined(MFC_OpenMP)
13041# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13042
13043# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13044#endif
13045 do i = 1, num_dims
13046 vel_src_rsz_vf(j, k, l, &
13047 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
13048 & *(s_s*(xi_mp*(xi_l - 1) + 1) - vel_l(dir_idx(i)))) &
13049 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(s_s*(xi_pp*(xi_r - 1) &
13050 & + 1) - vel_r(dir_idx(i))))
13051 end do
13052
13053 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
13054 ! energy flux
13055
13056# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13057#if defined(MFC_OpenACC)
13058# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13059!$acc loop seq
13060# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13061#elif defined(MFC_OpenMP)
13062# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13063
13064# 2113 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13065#endif
13066 do i = 1, num_fluids
13067 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
13068 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
13069 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
13070 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
13071 & + pres_r)
13072
13073 flux_rsz_vf(j, k, l, i + intxb - 1) = ((xi_m*ql_prim_rsz_vf(j, k, l, &
13074 & i + advxb - 1) + xi_p*qr_prim_rsz_vf(j + 1, k, l, &
13075 & i + advxb - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
13076 & + (xi_m*ql_prim_rsz_vf(j, k, l, &
13077 & i + contxb - 1) + xi_p*qr_prim_rsz_vf(j + 1, k, l, &
13078 & i + contxb - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
13079 & *pcorr*s_s*(xi_m*ql_prim_rsz_vf(j, k, l, &
13080 & i + advxb - 1) + xi_p*qr_prim_rsz_vf(j + 1, k, l, i + advxb - 1))
13081 end do
13082
13083 flux_src_rsz_vf(j, k, l, advxb) = vel_src_rsz_vf(j, k, l, dir_idx(1))
13084
13085 ! HYPOELASTIC STRESS EVOLUTION FLUX.
13086 if (hypoelasticity) then
13087
13088# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13089#if defined(MFC_OpenACC)
13090# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13091!$acc loop seq
13092# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13093#elif defined(MFC_OpenMP)
13094# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13095
13096# 2135 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13097#endif
13098 do i = 1, strxe - strxb + 1
13099 flux_rsz_vf(j, k, l, &
13100 & strxb - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
13101 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
13102 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
13103 end do
13104 end if
13105
13106 ! Hyperelastic reference map flux for material deformation tracking
13107 if (hyperelasticity) then
13108
13109# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13110#if defined(MFC_OpenACC)
13111# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13112!$acc loop seq
13113# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13114#elif defined(MFC_OpenMP)
13115# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13116
13117# 2146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13118#endif
13119 do i = 1, num_dims
13120 flux_rsz_vf(j, k, l, &
13121 & xibeg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
13122 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
13123 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
13124 end do
13125 end if
13126
13127 ! COLOR FUNCTION FLUX
13128 if (surface_tension) then
13129 flux_rsz_vf(j, k, l, c_idx) = (xi_m*ql_prim_rsz_vf(j, k, l, &
13130 & c_idx) + xi_p*qr_prim_rsz_vf(j + 1, k, l, c_idx))*s_s
13131 end if
13132
13133 ! Geometrical source flux for cylindrical coordinates
13134# 2183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13135# 2184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13136 if (grid_geometry == 3) then
13137
13138# 2185 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13139#if defined(MFC_OpenACC)
13140# 2185 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13141!$acc loop seq
13142# 2185 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13143#elif defined(MFC_OpenMP)
13144# 2185 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13145
13146# 2185 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13147#endif
13148 do i = 1, sys_size
13149 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
13150 end do
13151 flux_gsrc_rsz_vf(j, k, l, momxb - 1 + dir_idx(1)) = flux_gsrc_rsz_vf(j, k, l, &
13152 & momxb - 1 + dir_idx(1)) - p_star
13153
13154 flux_gsrc_rsz_vf(j, k, l, momxe) = flux_rsz_vf(j, k, l, momxb + 1)
13155 end if
13156# 2195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13157 end do
13158 end do
13159 end do
13160
13161# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13162#if defined(MFC_OpenACC)
13163# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13164!$acc end parallel loop
13165# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13166#elif defined(MFC_OpenMP)
13167# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13168
13169# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13170!$omp end target teams loop
13171# 2198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13172#endif
13173 else if (model_eqns == 4) then
13174 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
13175
13176# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13177
13178# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13179#if defined(MFC_OpenACC)
13180# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13181!$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)
13182# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13183#elif defined(MFC_OpenMP)
13184# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13185
13186# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13187
13188# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13189
13190# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13191!$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)
13192# 2201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13193#endif
13194# 2210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13195 do l = is3%beg, is3%end
13196 do k = is2%beg, is2%end
13197 do j = is1%beg, is1%end
13198 vel_l_rms = 0._wp; vel_r_rms = 0._wp
13199 rho_l = 0._wp; rho_r = 0._wp
13200 gamma_l = 0._wp; gamma_r = 0._wp
13201 pi_inf_l = 0._wp; pi_inf_r = 0._wp
13202 qv_l = 0._wp; qv_r = 0._wp
13203
13204
13205# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13206#if defined(MFC_OpenACC)
13207# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13208!$acc loop seq
13209# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13210#elif defined(MFC_OpenMP)
13211# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13212
13213# 2219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13214#endif
13215 do i = 1, contxe
13216 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
13217 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
13218 end do
13219
13220
13221# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13222#if defined(MFC_OpenACC)
13223# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13224!$acc loop seq
13225# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13226#elif defined(MFC_OpenMP)
13227# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13228
13229# 2225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13230#endif
13231 do i = 1, num_dims
13232 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
13233 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
13234 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
13235 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
13236 end do
13237
13238
13239# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13240#if defined(MFC_OpenACC)
13241# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13242!$acc loop seq
13243# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13244#elif defined(MFC_OpenMP)
13245# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13246
13247# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13248#endif
13249 do i = 1, num_fluids
13250 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
13251 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
13252 end do
13253
13254# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13255#if defined(MFC_OpenACC)
13256# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13257!$acc loop seq
13258# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13259#elif defined(MFC_OpenMP)
13260# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13261
13262# 2238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13263#endif
13264 do i = 1, num_fluids
13265 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
13266 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
13267 end do
13268
13269
13270# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13271#if defined(MFC_OpenACC)
13272# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13273!$acc loop seq
13274# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13275#elif defined(MFC_OpenMP)
13276# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13277
13278# 2244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13279#endif
13280 do i = 1, num_fluids
13281 rho_l = rho_l + alpha_rho_l(i)
13282 gamma_l = gamma_l + alpha_l(i)*gammas(i)
13283 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
13284 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
13285
13286 rho_r = rho_r + alpha_rho_r(i)
13287 gamma_r = gamma_r + alpha_r(i)*gammas(i)
13288 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
13289 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
13290 end do
13291
13292 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
13293 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
13294
13295 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
13296 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
13297
13298 h_l = (e_l + pres_l)/rho_l
13299 h_r = (e_r + pres_r)/rho_r
13300
13301 if (avg_state == 1) then
13302# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13303 rho_avg = sqrt(rho_l*rho_r)
13304# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13305
13306# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13307 vel_avg_rms = 0._wp
13308# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13309
13310# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13311
13312# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13313#if defined(MFC_OpenACC)
13314# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13315!$acc loop seq
13316# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13317#elif defined(MFC_OpenMP)
13318# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13319
13320# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13321#endif
13322# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13323 do i = 1, num_vels
13324# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13325 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
13326# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13327 end do
13328# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13329
13330# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13331 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
13332# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13333
13334# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13335 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
13336# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13337
13338# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13339 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
13340# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13341
13342# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13343 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
13344# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13345
13346# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13347 if (chemistry) then
13348# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13349 eps = 0.001_wp
13350# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13351 call get_species_enthalpies_rt(t_l, h_il)
13352# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13353 call get_species_enthalpies_rt(t_r, h_ir)
13354# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13355 h_il = h_il*gas_constant/molecular_weights*t_l
13356# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13357 h_ir = h_ir*gas_constant/molecular_weights*t_r
13358# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13359 call get_species_specific_heats_r(t_l, cp_il)
13360# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13361 call get_species_specific_heats_r(t_r, cp_ir)
13362# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13363
13364# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13365 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
13366# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13367 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
13368# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13369 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
13370# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13371 if (abs(t_l - t_r) < eps) then
13372# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13373 ! Case when T_L and T_R are very close
13374# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13375 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
13376# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13377 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
13378# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13379 & - gas_constant/molecular_weights(:)))
13380# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13381 else
13382# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13383 ! Normal calculation when T_L and T_R are sufficiently different
13384# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13385 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
13386# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13387 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
13388# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13389 end if
13390# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13391 gamma_avg = cp_avg/cv_avg
13392# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13393
13394# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13395 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
13396# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13397 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
13398# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13399 end if
13400# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13401 end if
13402# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13403
13404# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13405 if (avg_state == 2) then
13406# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13407 rho_avg = 5.e-1_wp*(rho_l + rho_r)
13408# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13409 vel_avg_rms = 0._wp
13410# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13411
13412# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13413#if defined(MFC_OpenACC)
13414# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13415!$acc loop seq
13416# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13417#elif defined(MFC_OpenMP)
13418# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13419
13420# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13421#endif
13422# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13423 do i = 1, num_vels
13424# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13425 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
13426# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13427 end do
13428# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13429
13430# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13431 h_avg = 5.e-1_wp*(h_l + h_r)
13432# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13433 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
13434# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13435 qv_avg = 5.e-1_wp*(qv_l + qv_r)
13436# 2266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13437 end if
13438
13439 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
13440 & c_l, qv_l)
13441
13442 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
13443 & c_r, qv_r)
13444
13445 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
13446 ! variables are placeholders to call the subroutine.
13447
13448 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
13449 & 0._wp, c_avg, qv_avg)
13450
13451 if (wave_speeds == 1) then
13452 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
13453 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
13454
13455 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
13456 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
13457 & - rho_r*(s_r - vel_r(dir_idx(1))))
13458 else if (wave_speeds == 2) then
13459 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
13460
13461 pres_sr = pres_sl
13462
13463 ! Low Mach correction: Thornber et al. JCP (2008)
13464 ms_l = max(1._wp, &
13465 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
13466 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
13467 ms_r = max(1._wp, &
13468 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
13469 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
13470
13471 s_l = vel_l(dir_idx(1)) - c_l*ms_l
13472 s_r = vel_r(dir_idx(1)) + c_r*ms_r
13473
13474 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
13475 end if
13476
13477 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
13478 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
13479
13480 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
13481 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
13482 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
13483
13484 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
13485 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
13486 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
13487
13488
13489# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13490#if defined(MFC_OpenACC)
13491# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13492!$acc loop seq
13493# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13494#elif defined(MFC_OpenMP)
13495# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13496
13497# 2317 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13498#endif
13499 do i = 1, contxe
13500 flux_rsz_vf(j, k, l, &
13501 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
13502 & + xi_p*alpha_rho_r(i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13503 end do
13504
13505 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
13506
13507# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13508#if defined(MFC_OpenACC)
13509# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13510!$acc loop seq
13511# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13512#elif defined(MFC_OpenMP)
13513# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13514
13515# 2325 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13516#endif
13517 do i = 1, num_dims
13518 flux_rsz_vf(j, k, l, &
13519 & contxe + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
13520 & + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
13521 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
13522 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
13523 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
13524 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
13525 end do
13526
13527 if (bubbles_euler) then
13528 ! Put p_tilde in
13529
13530# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13531#if defined(MFC_OpenACC)
13532# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13533!$acc loop seq
13534# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13535#elif defined(MFC_OpenMP)
13536# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13537
13538# 2338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13539#endif
13540 do i = 1, num_dims
13541 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = flux_rsz_vf(j, k, l, &
13542 & contxe + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l)) &
13543 & + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
13544 end do
13545 end if
13546
13547 flux_rsz_vf(j, k, l, e_idx) = 0._wp
13548
13549
13550# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13551#if defined(MFC_OpenACC)
13552# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13553!$acc loop seq
13554# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13555#elif defined(MFC_OpenMP)
13556# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13557
13558# 2348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13559#endif
13560 do i = alf_idx, alf_idx ! only advect the void fraction
13561 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
13562 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsz_vf(j &
13563 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13564 end do
13565
13566 ! Advection velocity source: interface velocity for volume fraction transport
13567
13568# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13569#if defined(MFC_OpenACC)
13570# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13571!$acc loop seq
13572# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13573#elif defined(MFC_OpenMP)
13574# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13575
13576# 2356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13577#endif
13578 do i = 1, num_dims
13579 vel_src_rsz_vf(j, k, l, dir_idx(i)) = 0._wp
13580 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
13581 end do
13582
13583 flux_src_rsz_vf(j, k, l, advxb) = vel_src_rsz_vf(j, k, l, dir_idx(1))
13584
13585 ! Add advection flux for bubble variables
13586 if (bubbles_euler) then
13587
13588# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13589#if defined(MFC_OpenACC)
13590# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13591!$acc loop seq
13592# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13593#elif defined(MFC_OpenMP)
13594# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13595
13596# 2366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13597#endif
13598 do i = bubxb, bubxe
13599 flux_rsz_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsz_vf(j, k, l, &
13600 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
13601 & + xi_p*nbub_r*qr_prim_rsz_vf(j + 1, k, l, &
13602 & i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13603 end do
13604 end if
13605
13606 ! Geometrical source flux for cylindrical coordinates
13607
13608# 2399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13609# 2400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13610 if (grid_geometry == 3) then
13611
13612# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13613#if defined(MFC_OpenACC)
13614# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13615!$acc loop seq
13616# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13617#elif defined(MFC_OpenMP)
13618# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13619
13620# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13621#endif
13622 do i = 1, sys_size
13623 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
13624 end do
13625 flux_gsrc_rsz_vf(j, k, l, &
13626 & momxb + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1)) &
13627 & + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
13628 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
13629 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
13630 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp &
13631 & - dir_flg(dir_idx(1)))*vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
13632 flux_gsrc_rsz_vf(j, k, l, momxe) = flux_rsz_vf(j, k, l, momxb + 1)
13633 end if
13634# 2415 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13635 end do
13636 end do
13637 end do
13638
13639# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13640#if defined(MFC_OpenACC)
13641# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13642!$acc end parallel loop
13643# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13644#elif defined(MFC_OpenMP)
13645# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13646
13647# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13648!$omp end target teams loop
13649# 2418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13650#endif
13651 else if (model_eqns == 2 .and. bubbles_euler) then
13652 ! 5-equation model with Euler-Euler bubble dynamics
13653
13654# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13655
13656# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13657#if defined(MFC_OpenACC)
13658# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13659!$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)
13660# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13661#elif defined(MFC_OpenMP)
13662# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13663
13664# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13665
13666# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13667
13668# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13669!$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)
13670# 2421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13671#endif
13672# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13673 do l = is3%beg, is3%end
13674 do k = is2%beg, is2%end
13675 do j = is1%beg, is1%end
13676 vel_l_rms = 0._wp; vel_r_rms = 0._wp
13677 rho_l = 0._wp; rho_r = 0._wp
13678 gamma_l = 0._wp; gamma_r = 0._wp
13679 pi_inf_l = 0._wp; pi_inf_r = 0._wp
13680 qv_l = 0._wp; qv_r = 0._wp
13681
13682
13683# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13684#if defined(MFC_OpenACC)
13685# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13686!$acc loop seq
13687# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13688#elif defined(MFC_OpenMP)
13689# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13690
13691# 2438 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13692#endif
13693 do i = 1, num_fluids
13694 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
13695 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
13696 end do
13697
13698 vel_l_rms = 0._wp; vel_r_rms = 0._wp
13699
13700
13701# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13702#if defined(MFC_OpenACC)
13703# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13704!$acc loop seq
13705# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13706#elif defined(MFC_OpenMP)
13707# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13708
13709# 2446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13710#endif
13711 do i = 1, num_dims
13712 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
13713 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
13714 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
13715 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
13716 end do
13717
13718 ! Retain this in the refactor
13719 if (mpp_lim .and. (num_fluids > 2)) then
13720
13721# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13722#if defined(MFC_OpenACC)
13723# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13724!$acc loop seq
13725# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13726#elif defined(MFC_OpenMP)
13727# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13728
13729# 2456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13730#endif
13731 do i = 1, num_fluids
13732 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
13733 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*gammas(i)
13734 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*pi_infs(i)
13735 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
13736 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
13737 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*gammas(i)
13738 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
13739 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
13740 end do
13741 else if (num_fluids > 2) then
13742
13743# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13744#if defined(MFC_OpenACC)
13745# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13746!$acc loop seq
13747# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13748#elif defined(MFC_OpenMP)
13749# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13750
13751# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13752#endif
13753 do i = 1, num_fluids - 1
13754 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
13755 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*gammas(i)
13756 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*pi_infs(i)
13757 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
13758 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
13759 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*gammas(i)
13760 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
13761 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
13762 end do
13763 else
13764 rho_l = ql_prim_rsz_vf(j, k, l, 1)
13765 gamma_l = gammas(1)
13766 pi_inf_l = pi_infs(1)
13767 qv_l = qvs(1)
13768 rho_r = qr_prim_rsz_vf(j + 1, k, l, 1)
13769 gamma_r = gammas(1)
13770 pi_inf_r = pi_infs(1)
13771 qv_r = qvs(1)
13772 end if
13773
13774 if (viscous) then
13775 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
13776
13777# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13778#if defined(MFC_OpenACC)
13779# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13780!$acc loop seq
13781# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13782#elif defined(MFC_OpenMP)
13783# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13784
13785# 2492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13786#endif
13787 do i = 1, 2
13788 re_l(i) = dflt_real
13789 re_r(i) = dflt_real
13790
13791 if (re_size(i) > 0) re_l(i) = 0._wp
13792 if (re_size(i) > 0) re_r(i) = 0._wp
13793
13794
13795# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13796#if defined(MFC_OpenACC)
13797# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13798!$acc loop seq
13799# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13800#elif defined(MFC_OpenMP)
13801# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13802
13803# 2500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13804#endif
13805 do q = 1, re_size(i)
13806 re_l(i) = (1._wp - ql_prim_rsz_vf(j, k, l, e_idx + re_idx(i, q)))/res_gs(i, &
13807 & q) + re_l(i)
13808 re_r(i) = (1._wp - qr_prim_rsz_vf(j + 1, k, l, e_idx + re_idx(i, &
13809 & q)))/res_gs(i, q) + re_r(i)
13810 end do
13811
13812 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
13813 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
13814 end do
13815 end if
13816 end if
13817
13818 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
13819 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
13820
13821 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
13822 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
13823
13824 h_l = (e_l + pres_l)/rho_l
13825 h_r = (e_r + pres_r)/rho_r
13826
13827 if (avg_state == 2) then
13828
13829# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13830#if defined(MFC_OpenACC)
13831# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13832!$acc loop seq
13833# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13834#elif defined(MFC_OpenMP)
13835# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13836
13837# 2524 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13838#endif
13839 do i = 1, nb
13840 r0_l(i) = ql_prim_rsz_vf(j, k, l, rs(i))
13841 r0_r(i) = qr_prim_rsz_vf(j + 1, k, l, rs(i))
13842
13843 v0_l(i) = ql_prim_rsz_vf(j, k, l, vs(i))
13844 v0_r(i) = qr_prim_rsz_vf(j + 1, k, l, vs(i))
13845 if (.not. polytropic .and. .not. qbmm) then
13846 p0_l(i) = ql_prim_rsz_vf(j, k, l, ps(i))
13847 p0_r(i) = qr_prim_rsz_vf(j + 1, k, l, ps(i))
13848 end if
13849 end do
13850
13851 if (.not. qbmm) then
13852 if (adv_n) then
13853 nbub_l = ql_prim_rsz_vf(j, k, l, n_idx)
13854 nbub_r = qr_prim_rsz_vf(j + 1, k, l, n_idx)
13855 else
13856 nbub_l = 0._wp
13857 nbub_r = 0._wp
13858
13859# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13860#if defined(MFC_OpenACC)
13861# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13862!$acc loop seq
13863# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13864#elif defined(MFC_OpenMP)
13865# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13866
13867# 2544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13868#endif
13869 do i = 1, nb
13870 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
13871 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
13872 end do
13873
13874 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsz_vf(j, k, l, e_idx + num_fluids)/nbub_l
13875 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsz_vf(j + 1, k, l, e_idx + num_fluids)/nbub_r
13876 end if
13877 else
13878 ! nb stored in 0th moment of first R0 bin in variable conversion module
13879 nbub_l = ql_prim_rsz_vf(j, k, l, bubxb)
13880 nbub_r = qr_prim_rsz_vf(j + 1, k, l, bubxb)
13881 end if
13882
13883
13884# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13885#if defined(MFC_OpenACC)
13886# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13887!$acc loop seq
13888# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13889#elif defined(MFC_OpenMP)
13890# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13891
13892# 2559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13893#endif
13894 do i = 1, nb
13895 if (.not. qbmm) then
13896 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
13897 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
13898 end if
13899 end do
13900
13901 if (qbmm) then
13902 pbwr3lbar = mom_sp_rsz_vf(j, k, l, 4)
13903 pbwr3rbar = mom_sp_rsz_vf(j + 1, k, l, 4)
13904
13905 r3lbar = mom_sp_rsz_vf(j, k, l, 1)
13906 r3rbar = mom_sp_rsz_vf(j + 1, k, l, 1)
13907
13908 r3v2lbar = mom_sp_rsz_vf(j, k, l, 3)
13909 r3v2rbar = mom_sp_rsz_vf(j + 1, k, l, 3)
13910 else
13911 pbwr3lbar = 0._wp
13912 pbwr3rbar = 0._wp
13913
13914 r3lbar = 0._wp
13915 r3rbar = 0._wp
13916
13917 r3v2lbar = 0._wp
13918 r3v2rbar = 0._wp
13919
13920
13921# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13922#if defined(MFC_OpenACC)
13923# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13924!$acc loop seq
13925# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13926#elif defined(MFC_OpenMP)
13927# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13928
13929# 2586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13930#endif
13931 do i = 1, nb
13932 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
13933 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
13934
13935 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
13936 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
13937
13938 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
13939 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
13940 end do
13941 end if
13942
13943 rho_avg = 5.e-1_wp*(rho_l + rho_r)
13944 h_avg = 5.e-1_wp*(h_l + h_r)
13945 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
13946 qv_avg = 5.e-1_wp*(qv_l + qv_r)
13947 vel_avg_rms = 0._wp
13948
13949
13950# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13951#if defined(MFC_OpenACC)
13952# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13953!$acc loop seq
13954# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13955#elif defined(MFC_OpenMP)
13956# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13957
13958# 2605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13959#endif
13960 do i = 1, num_dims
13961 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
13962 end do
13963 end if
13964
13965 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
13966 & c_l, qv_l)
13967
13968 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
13969 & c_r, qv_r)
13970
13971 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
13972 ! variables are placeholders to call the subroutine.
13973 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
13974 & 0._wp, c_avg, qv_avg)
13975
13976 if (viscous) then
13977
13978# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13979#if defined(MFC_OpenACC)
13980# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13981!$acc loop seq
13982# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13983#elif defined(MFC_OpenMP)
13984# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13985
13986# 2623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13987#endif
13988 do i = 1, 2
13989 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
13990 end do
13991 end if
13992
13993 ! Low Mach correction
13994 if (low_mach == 2) then
13995 if (riemann_solver == 1 .or. riemann_solver == 5) then
13996# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13997 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
13998# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13999 pcorr = 0._wp
14000# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14001
14002# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14003 if (low_mach == 1) then
14004# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14005 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14006# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14007 end if
14008# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14009 else if (riemann_solver == 2) then
14010# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14011 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14012# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14013 pcorr = 0._wp
14014# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14015
14016# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14017 if (low_mach == 1) then
14018# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14019 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))) &
14020# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14021 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14022# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14023 else if (low_mach == 2) then
14024# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14025 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))))
14026# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14027 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))))
14028# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14029 vel_l(dir_idx(1)) = vel_l_tmp
14030# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14031 vel_r(dir_idx(1)) = vel_r_tmp
14032# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14033 end if
14034# 2631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14035 end if
14036 end if
14037
14038 if (wave_speeds == 1) then
14039 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
14040 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
14041
14042 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
14043 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
14044 & - rho_r*(s_r - vel_r(dir_idx(1))))
14045 else if (wave_speeds == 2) then
14046 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
14047
14048 pres_sr = pres_sl
14049
14050 ! Low Mach correction: Thornber et al. JCP (2008)
14051 ms_l = max(1._wp, &
14052 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
14053 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
14054 ms_r = max(1._wp, &
14055 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
14056 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
14057
14058 s_l = vel_l(dir_idx(1)) - c_l*ms_l
14059 s_r = vel_r(dir_idx(1)) + c_r*ms_r
14060
14061 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
14062 end if
14063
14064 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
14065 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
14066
14067 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
14068 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
14069 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
14070
14071 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
14072 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
14073 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
14074
14075 ! Low Mach correction
14076 if (low_mach == 1) then
14077 if (riemann_solver == 1 .or. riemann_solver == 5) then
14078# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14079 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14080# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14081 pcorr = 0._wp
14082# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14083
14084# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14085 if (low_mach == 1) then
14086# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14087 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14088# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14089 end if
14090# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14091 else if (riemann_solver == 2) then
14092# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14093 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14094# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14095 pcorr = 0._wp
14096# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14097
14098# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14099 if (low_mach == 1) then
14100# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14101 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))) &
14102# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14103 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14104# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14105 else if (low_mach == 2) then
14106# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14107 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))))
14108# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14109 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))))
14110# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14111 vel_l(dir_idx(1)) = vel_l_tmp
14112# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14113 vel_r(dir_idx(1)) = vel_r_tmp
14114# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14115 end if
14116# 2673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14117 end if
14118 else
14119 pcorr = 0._wp
14120 end if
14121
14122
14123# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14124#if defined(MFC_OpenACC)
14125# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14126!$acc loop seq
14127# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14128#elif defined(MFC_OpenMP)
14129# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14130
14131# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14132#endif
14133 do i = 1, contxe
14134 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
14135 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsz_vf(j &
14136 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14137 end do
14138
14139 if (bubbles_euler .and. (num_fluids > 1)) then
14140 ! Kill mass transport @ gas density
14141 flux_rsz_vf(j, k, l, contxe) = 0._wp
14142 end if
14143
14144 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
14145
14146 ! Include p_tilde
14147
14148 if (avg_state == 2) then
14149 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
14150 pres_l = pres_l - alpha_l(num_fluids)*pres_l
14151 else
14152 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
14153 end if
14154
14155 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
14156 pres_r = pres_r - alpha_r(num_fluids)*pres_r
14157 else
14158 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
14159 end if
14160 end if
14161
14162
14163# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14164#if defined(MFC_OpenACC)
14165# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14166!$acc loop seq
14167# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14168#elif defined(MFC_OpenMP)
14169# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14170
14171# 2708 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14172#endif
14173 do i = 1, num_dims
14174 flux_rsz_vf(j, k, l, &
14175 & contxe + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
14176 & + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
14177 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
14178 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
14179 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
14180 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
14181 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
14182 end do
14183
14184 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
14185 flux_rsz_vf(j, k, l, &
14186 & e_idx) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
14187 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
14188 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s &
14189 & - vel_r(dir_idx(1)))*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) &
14190 & + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
14191
14192 ! Volume fraction flux
14193
14194# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14195#if defined(MFC_OpenACC)
14196# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14197!$acc loop seq
14198# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14199#elif defined(MFC_OpenMP)
14200# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14201
14202# 2729 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14203#endif
14204 do i = advxb, advxe
14205 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
14206 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsz_vf(j &
14207 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14208 end do
14209
14210 ! Advection velocity source: interface velocity for volume fraction transport
14211
14212# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14213#if defined(MFC_OpenACC)
14214# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14215!$acc loop seq
14216# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14217#elif defined(MFC_OpenMP)
14218# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14219
14220# 2737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14221#endif
14222 do i = 1, num_dims
14223 vel_src_rsz_vf(j, k, l, &
14224 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*(xi_l &
14225 & - 1._wp)) + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*(xi_r &
14226 & - 1._wp))
14227
14228 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
14229 end do
14230
14231 flux_src_rsz_vf(j, k, l, advxb) = vel_src_rsz_vf(j, k, l, dir_idx(1))
14232
14233 ! Add advection flux for bubble variables
14234
14235# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14236#if defined(MFC_OpenACC)
14237# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14238!$acc loop seq
14239# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14240#elif defined(MFC_OpenMP)
14241# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14242
14243# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14244#endif
14245 do i = bubxb, bubxe
14246 flux_rsz_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsz_vf(j, k, l, &
14247 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
14248 & + xi_p*nbub_r*qr_prim_rsz_vf(j + 1, k, l, &
14249 & i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14250 end do
14251
14252 if (qbmm) then
14253 flux_rsz_vf(j, k, l, &
14254 & bubxb) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
14255 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14256 end if
14257
14258 if (adv_n) then
14259 flux_rsz_vf(j, k, l, &
14260 & n_idx) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
14261 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14262 end if
14263
14264 ! Geometrical source flux for cylindrical coordinates
14265# 2793 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14266# 2794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14267 if (grid_geometry == 3) then
14268
14269# 2795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14270#if defined(MFC_OpenACC)
14271# 2795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14272!$acc loop seq
14273# 2795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14274#elif defined(MFC_OpenMP)
14275# 2795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14276
14277# 2795 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14278#endif
14279 do i = 1, sys_size
14280 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
14281 end do
14282
14283 flux_gsrc_rsz_vf(j, k, l, &
14284 & momxb + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1)) &
14285 & + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
14286 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
14287 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
14288 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp &
14289 & - dir_flg(dir_idx(1)))*vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
14290 flux_gsrc_rsz_vf(j, k, l, momxe) = flux_rsz_vf(j, k, l, momxb + 1)
14291 end if
14292# 2810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14293 end do
14294 end do
14295 end do
14296
14297# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14298#if defined(MFC_OpenACC)
14299# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14300!$acc end parallel loop
14301# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14302#elif defined(MFC_OpenMP)
14303# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14304
14305# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14306!$omp end target teams loop
14307# 2813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14308#endif
14309 else
14310 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
14311
14312# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14313
14314# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14315#if defined(MFC_OpenACC)
14316# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14317!$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)
14318# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14319#elif defined(MFC_OpenMP)
14320# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14321
14322# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14323
14324# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14325
14326# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14327!$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)
14328# 2816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14329#endif
14330# 2824 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14331 do l = is3%beg, is3%end
14332 do k = is2%beg, is2%end
14333 do j = is1%beg, is1%end
14334 vel_l_rms = 0._wp; vel_r_rms = 0._wp
14335 rho_l = 0._wp; rho_r = 0._wp
14336 gamma_l = 0._wp; gamma_r = 0._wp
14337 pi_inf_l = 0._wp; pi_inf_r = 0._wp
14338 qv_l = 0._wp; qv_r = 0._wp
14339 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
14340
14341
14342# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14343#if defined(MFC_OpenACC)
14344# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14345!$acc loop seq
14346# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14347#elif defined(MFC_OpenMP)
14348# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14349
14350# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14351#endif
14352 do i = 1, num_fluids
14353 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
14354 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
14355 end do
14356
14357
14358# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14359#if defined(MFC_OpenACC)
14360# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14361!$acc loop seq
14362# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14363#elif defined(MFC_OpenMP)
14364# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14365
14366# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14367#endif
14368 do i = 1, num_dims
14369 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
14370 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
14371 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
14372 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
14373 end do
14374
14375 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
14376 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
14377
14378 ! Change this by splitting it into the cases present in the bubbles_euler
14379 if (mpp_lim) then
14380
14381# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14382#if defined(MFC_OpenACC)
14383# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14384!$acc loop seq
14385# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14386#elif defined(MFC_OpenMP)
14387# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14388
14389# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14390#endif
14391 do i = 1, num_fluids
14392 ql_prim_rsz_vf(j, k, l, i) = max(0._wp, ql_prim_rsz_vf(j, k, l, i))
14393 ql_prim_rsz_vf(j, k, l, e_idx + i) = min(max(0._wp, ql_prim_rsz_vf(j, k, l, &
14394 & e_idx + i)), 1._wp)
14395 qr_prim_rsz_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsz_vf(j + 1, k, l, i))
14396 qr_prim_rsz_vf(j + 1, k, l, e_idx + i) = min(max(0._wp, qr_prim_rsz_vf(j + 1, &
14397 & k, l, e_idx + i)), 1._wp)
14398 alpha_l_sum = alpha_l_sum + ql_prim_rsz_vf(j, k, l, e_idx + i)
14399 alpha_r_sum = alpha_r_sum + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
14400 end do
14401
14402
14403# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14404#if defined(MFC_OpenACC)
14405# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14406!$acc loop seq
14407# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14408#elif defined(MFC_OpenMP)
14409# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14410
14411# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14412#endif
14413 do i = 1, num_fluids
14414 ql_prim_rsz_vf(j, k, l, e_idx + i) = ql_prim_rsz_vf(j, k, l, &
14415 & e_idx + i)/max(alpha_l_sum, sgm_eps)
14416 qr_prim_rsz_vf(j + 1, k, l, e_idx + i) = qr_prim_rsz_vf(j + 1, k, l, &
14417 & e_idx + i)/max(alpha_r_sum, sgm_eps)
14418 end do
14419 end if
14420
14421
14422# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14423#if defined(MFC_OpenACC)
14424# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14425!$acc loop seq
14426# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14427#elif defined(MFC_OpenMP)
14428# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14429
14430# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14431#endif
14432 do i = 1, num_fluids
14433 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
14434 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*gammas(i)
14435 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*pi_infs(i)
14436 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
14437
14438 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
14439 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*gammas(i)
14440 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
14441 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
14442 end do
14443
14444 re_max = 0
14445 if (re_size(1) > 0) re_max = 1
14446 if (re_size(2) > 0) re_max = 2
14447
14448 if (viscous) then
14449
14450# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14451#if defined(MFC_OpenACC)
14452# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14453!$acc loop seq
14454# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14455#elif defined(MFC_OpenMP)
14456# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14457
14458# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14459#endif
14460 do i = 1, re_max
14461 re_l(i) = 0._wp
14462 re_r(i) = 0._wp
14463
14464
14465# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14466#if defined(MFC_OpenACC)
14467# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14468!$acc loop seq
14469# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14470#elif defined(MFC_OpenMP)
14471# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14472
14473# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14474#endif
14475 do q = 1, re_size(i)
14476 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
14477 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
14478 end do
14479
14480 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
14481 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
14482 end do
14483 end if
14484
14485 if (chemistry) then
14486 c_sum_yi_phi = 0.0_wp
14487
14488# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14489#if defined(MFC_OpenACC)
14490# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14491!$acc loop seq
14492# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14493#elif defined(MFC_OpenMP)
14494# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14495
14496# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14497#endif
14498 do i = chemxb, chemxe
14499 ys_l(i - chemxb + 1) = ql_prim_rsz_vf(j, k, l, i)
14500 ys_r(i - chemxb + 1) = qr_prim_rsz_vf(j + 1, k, l, i)
14501 end do
14502
14503 call get_mixture_molecular_weight(ys_l, mw_l)
14504 call get_mixture_molecular_weight(ys_r, mw_r)
14505
14506# 2923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14507 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
14508 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
14509# 2926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14510
14511 r_gas_l = gas_constant/mw_l
14512 r_gas_r = gas_constant/mw_r
14513
14514 t_l = pres_l/rho_l/r_gas_l
14515 t_r = pres_r/rho_r/r_gas_r
14516
14517 call get_species_specific_heats_r(t_l, cp_il)
14518 call get_species_specific_heats_r(t_r, cp_ir)
14519
14520 if (chem_params%gamma_method == 1) then
14521 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
14522 gamma_il = cp_il/(cp_il - 1.0_wp)
14523 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
14524
14525 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
14526 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
14527 else if (chem_params%gamma_method == 2) then
14528 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
14529 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
14530 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
14531 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
14532 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
14533
14534 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
14535 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
14536 end if
14537
14538 call get_mixture_energy_mass(t_l, ys_l, e_l)
14539 call get_mixture_energy_mass(t_r, ys_r, e_r)
14540
14541 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
14542 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
14543 h_l = (e_l + pres_l)/rho_l
14544 h_r = (e_r + pres_r)/rho_r
14545 else
14546 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
14547 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
14548
14549 h_l = (e_l + pres_l)/rho_l
14550 h_r = (e_r + pres_r)/rho_r
14551 end if
14552
14553 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
14554 if (hypoelasticity) then
14555
14556# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14557#if defined(MFC_OpenACC)
14558# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14559!$acc loop seq
14560# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14561#elif defined(MFC_OpenMP)
14562# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14563
14564# 2971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14565#endif
14566 do i = 1, strxe - strxb + 1
14567 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
14568 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
14569 end do
14570 g_l = 0._wp
14571 g_r = 0._wp
14572
14573# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14574#if defined(MFC_OpenACC)
14575# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14576!$acc loop seq
14577# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14578#elif defined(MFC_OpenMP)
14579# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14580
14581# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14582#endif
14583 do i = 1, num_fluids
14584 g_l = g_l + alpha_l(i)*gs_rs(i)
14585 g_r = g_r + alpha_r(i)*gs_rs(i)
14586 end do
14587
14588# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14589#if defined(MFC_OpenACC)
14590# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14591!$acc loop seq
14592# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14593#elif defined(MFC_OpenMP)
14594# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14595
14596# 2983 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14597#endif
14598 do i = 1, strxe - strxb + 1
14599 ! Elastic contribution to energy if G large enough
14600 if ((g_l > verysmall) .and. (g_r > verysmall)) then
14601 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
14602 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
14603 ! Additional terms in 2D and 3D
14604 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
14605 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
14606 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
14607 end if
14608 end if
14609 end do
14610 end if
14611
14612 ! Hyperelastic stress contribution: strain energy added to total energy
14613 if (hyperelasticity) then
14614
14615# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14616#if defined(MFC_OpenACC)
14617# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14618!$acc loop seq
14619# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14620#elif defined(MFC_OpenMP)
14621# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14622
14623# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14624#endif
14625 do i = 1, num_dims
14626 xi_field_l(i) = ql_prim_rsz_vf(j, k, l, xibeg - 1 + i)
14627 xi_field_r(i) = qr_prim_rsz_vf(j + 1, k, l, xibeg - 1 + i)
14628 end do
14629 g_l = 0._wp
14630 g_r = 0._wp
14631
14632# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14633#if defined(MFC_OpenACC)
14634# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14635!$acc loop seq
14636# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14637#elif defined(MFC_OpenMP)
14638# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14639
14640# 3007 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14641#endif
14642 do i = 1, num_fluids
14643 ! Mixture left and right shear modulus
14644 g_l = g_l + alpha_l(i)*gs_rs(i)
14645 g_r = g_r + alpha_r(i)*gs_rs(i)
14646 end do
14647 ! Elastic contribution to energy if G large enough
14648 if (g_l > verysmall .and. g_r > verysmall) then
14649 e_l = e_l + g_l*ql_prim_rsz_vf(j, k, l, xiend + 1)
14650 e_r = e_r + g_r*qr_prim_rsz_vf(j + 1, k, l, xiend + 1)
14651 end if
14652
14653# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14654#if defined(MFC_OpenACC)
14655# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14656!$acc loop seq
14657# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14658#elif defined(MFC_OpenMP)
14659# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14660
14661# 3018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14662#endif
14663 do i = 1, b_size - 1
14664 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
14665 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
14666 end do
14667 end if
14668
14669 h_l = (e_l + pres_l)/rho_l
14670 h_r = (e_r + pres_r)/rho_r
14671
14672 if (avg_state == 1) then
14673# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14674 rho_avg = sqrt(rho_l*rho_r)
14675# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14676
14677# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14678 vel_avg_rms = 0._wp
14679# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14680
14681# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14682
14683# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14684#if defined(MFC_OpenACC)
14685# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14686!$acc loop seq
14687# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14688#elif defined(MFC_OpenMP)
14689# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14690
14691# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14692#endif
14693# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14694 do i = 1, num_vels
14695# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14696 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
14697# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14698 end do
14699# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14700
14701# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14702 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
14703# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14704
14705# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14706 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
14707# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14708
14709# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14710 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
14711# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14712
14713# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14714 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
14715# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14716
14717# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14718 if (chemistry) then
14719# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14720 eps = 0.001_wp
14721# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14722 call get_species_enthalpies_rt(t_l, h_il)
14723# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14724 call get_species_enthalpies_rt(t_r, h_ir)
14725# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14726 h_il = h_il*gas_constant/molecular_weights*t_l
14727# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14728 h_ir = h_ir*gas_constant/molecular_weights*t_r
14729# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14730 call get_species_specific_heats_r(t_l, cp_il)
14731# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14732 call get_species_specific_heats_r(t_r, cp_ir)
14733# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14734
14735# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14736 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
14737# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14738 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
14739# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14740 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
14741# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14742 if (abs(t_l - t_r) < eps) then
14743# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14744 ! Case when T_L and T_R are very close
14745# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14746 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
14747# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14748 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
14749# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14750 & - gas_constant/molecular_weights(:)))
14751# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14752 else
14753# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14754 ! Normal calculation when T_L and T_R are sufficiently different
14755# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14756 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
14757# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14758 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
14759# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14760 end if
14761# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14762 gamma_avg = cp_avg/cv_avg
14763# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14764
14765# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14766 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
14767# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14768 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
14769# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14770 end if
14771# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14772 end if
14773# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14774
14775# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14776 if (avg_state == 2) then
14777# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14778 rho_avg = 5.e-1_wp*(rho_l + rho_r)
14779# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14780 vel_avg_rms = 0._wp
14781# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14782
14783# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14784#if defined(MFC_OpenACC)
14785# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14786!$acc loop seq
14787# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14788#elif defined(MFC_OpenMP)
14789# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14790
14791# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14792#endif
14793# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14794 do i = 1, num_vels
14795# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14796 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
14797# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14798 end do
14799# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14800
14801# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14802 h_avg = 5.e-1_wp*(h_l + h_r)
14803# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14804 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
14805# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14806 qv_avg = 5.e-1_wp*(qv_l + qv_r)
14807# 3028 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14808 end if
14809
14810 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
14811 & c_l, qv_l)
14812
14813 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
14814 & c_r, qv_r)
14815
14816 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
14817 ! variables are placeholders to call the subroutine.
14818 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
14819 & c_sum_yi_phi, c_avg, qv_avg)
14820
14821 if (viscous) then
14822 if (chemistry) then
14823 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
14824 end if
14825
14826# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14827#if defined(MFC_OpenACC)
14828# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14829!$acc loop seq
14830# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14831#elif defined(MFC_OpenMP)
14832# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14833
14834# 3045 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14835#endif
14836 do i = 1, 2
14837 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
14838 end do
14839 end if
14840
14841 ! Low Mach correction
14842 if (low_mach == 2) then
14843 if (riemann_solver == 1 .or. riemann_solver == 5) then
14844# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14845 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14846# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14847 pcorr = 0._wp
14848# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14849
14850# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14851 if (low_mach == 1) then
14852# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14853 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14854# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14855 end if
14856# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14857 else if (riemann_solver == 2) then
14858# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14859 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14860# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14861 pcorr = 0._wp
14862# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14863
14864# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14865 if (low_mach == 1) then
14866# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14867 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))) &
14868# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14869 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14870# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14871 else if (low_mach == 2) then
14872# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14873 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))))
14874# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14875 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))))
14876# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14877 vel_l(dir_idx(1)) = vel_l_tmp
14878# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14879 vel_r(dir_idx(1)) = vel_r_tmp
14880# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14881 end if
14882# 3053 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14883 end if
14884 end if
14885
14886 if (wave_speeds == 1) then
14887 if (elasticity) then
14888 ! Elastic wave speed, Rodriguez et al. JCP (2019)
14889 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) &
14890 & ))/rho_l), &
14891 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
14892 & + tau_e_r(dir_idx_tau(1)))/rho_r))
14893 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) &
14894 & ))/rho_r), &
14895 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
14896 & + tau_e_l(dir_idx_tau(1)))/rho_l))
14897 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
14898 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
14899 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
14900 & - vel_r(dir_idx(1))))
14901 else
14902 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
14903 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
14904 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
14905 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
14906 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
14907 end if
14908 else if (wave_speeds == 2) then
14909 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
14910
14911 pres_sr = pres_sl
14912
14913 ! Low Mach correction: Thornber et al. JCP (2008)
14914 ms_l = max(1._wp, &
14915 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
14916 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
14917 ms_r = max(1._wp, &
14918 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
14919 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
14920
14921 s_l = vel_l(dir_idx(1)) - c_l*ms_l
14922 s_r = vel_r(dir_idx(1)) + c_r*ms_r
14923
14924 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
14925 end if
14926
14927 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
14928 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
14929
14930 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
14931 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
14932 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
14933
14934 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
14935 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
14936 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
14937
14938 ! Low Mach correction
14939 if (low_mach == 1) then
14940 if (riemann_solver == 1 .or. riemann_solver == 5) then
14941# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14942 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14943# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14944 pcorr = 0._wp
14945# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14946
14947# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14948 if (low_mach == 1) then
14949# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14950 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14951# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14952 end if
14953# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14954 else if (riemann_solver == 2) then
14955# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14956 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14957# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14958 pcorr = 0._wp
14959# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14960
14961# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14962 if (low_mach == 1) then
14963# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14964 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))) &
14965# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14966 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14967# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14968 else if (low_mach == 2) then
14969# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14970 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))))
14971# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14972 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))))
14973# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14974 vel_l(dir_idx(1)) = vel_l_tmp
14975# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14976 vel_r(dir_idx(1)) = vel_r_tmp
14977# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14978 end if
14979# 3110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14980 end if
14981 else
14982 pcorr = 0._wp
14983 end if
14984
14985 ! COMPUTING THE HLLC FLUXES MASS FLUX.
14986
14987# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14988#if defined(MFC_OpenACC)
14989# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14990!$acc loop seq
14991# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14992#elif defined(MFC_OpenMP)
14993# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14994
14995# 3116 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14996#endif
14997 do i = 1, contxe
14998 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
14999 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsz_vf(j &
15000 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15001 end do
15002
15003 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
15004
15005# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15006#if defined(MFC_OpenACC)
15007# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15008!$acc loop seq
15009# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15010#elif defined(MFC_OpenMP)
15011# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15012
15013# 3124 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15014#endif
15015 do i = 1, num_dims
15016 flux_rsz_vf(j, k, l, &
15017 & contxe + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
15018 & + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
15019 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
15020 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
15021 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
15022 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
15023 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
15024 end do
15025
15026 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
15027 flux_rsz_vf(j, k, l, &
15028 & e_idx) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
15029 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1))))) - e_l)) &
15030 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s &
15031 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r)) &
15032 & + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
15033
15034 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
15035 if (elasticity) then
15036 flux_ene_e = 0._wp
15037
15038# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15039#if defined(MFC_OpenACC)
15040# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15041!$acc loop seq
15042# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15043#elif defined(MFC_OpenMP)
15044# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15045
15046# 3147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15047#endif
15048 do i = 1, num_dims
15049 ! MOMENTUM ELASTIC FLUX.
15050 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = flux_rsz_vf(j, k, l, &
15051 & contxe + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
15052 & - xi_p*tau_e_r(dir_idx_tau(i))
15053 ! ENERGY ELASTIC FLUX.
15054 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
15055 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
15056 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
15057 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
15058 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
15059 end do
15060 flux_rsz_vf(j, k, l, e_idx) = flux_rsz_vf(j, k, l, e_idx) + flux_ene_e
15061 end if
15062
15063 ! HYPOELASTIC STRESS EVOLUTION FLUX.
15064 if (hypoelasticity) then
15065
15066# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15067#if defined(MFC_OpenACC)
15068# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15069!$acc loop seq
15070# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15071#elif defined(MFC_OpenMP)
15072# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15073
15074# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15075#endif
15076 do i = 1, strxe - strxb + 1
15077 flux_rsz_vf(j, k, l, &
15078 & strxb - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
15079 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
15080 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
15081 end do
15082 end if
15083
15084 ! VOLUME FRACTION FLUX.
15085
15086# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15087#if defined(MFC_OpenACC)
15088# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15089!$acc loop seq
15090# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15091#elif defined(MFC_OpenMP)
15092# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15093
15094# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15095#endif
15096 do i = advxb, advxe
15097 flux_rsz_vf(j, k, l, i) = xi_m*ql_prim_rsz_vf(j, k, l, &
15098 & i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + xi_p*qr_prim_rsz_vf(j &
15099 & + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15100 end do
15101
15102 ! VOLUME FRACTION SOURCE FLUX.
15103
15104# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15105#if defined(MFC_OpenACC)
15106# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15107!$acc loop seq
15108# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15109#elif defined(MFC_OpenMP)
15110# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15111
15112# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15113#endif
15114 do i = 1, num_dims
15115 vel_src_rsz_vf(j, k, l, &
15116 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*(xi_l &
15117 & - 1._wp)) + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*(xi_r &
15118 & - 1._wp))
15119 end do
15120
15121 ! COLOR FUNCTION FLUX
15122 if (surface_tension) then
15123 flux_rsz_vf(j, k, l, c_idx) = xi_m*ql_prim_rsz_vf(j, k, l, &
15124 & c_idx)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15125 & + xi_p*qr_prim_rsz_vf(j + 1, k, l, &
15126 & c_idx)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15127 end if
15128
15129 ! Hyperelastic reference map flux for material deformation tracking
15130 if (hyperelasticity) then
15131
15132# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15133#if defined(MFC_OpenACC)
15134# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15135!$acc loop seq
15136# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15137#elif defined(MFC_OpenMP)
15138# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15139
15140# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15141#endif
15142 do i = 1, num_dims
15143 flux_rsz_vf(j, k, l, &
15144 & xibeg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
15145 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
15146 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
15147 end do
15148 end if
15149
15150 flux_src_rsz_vf(j, k, l, advxb) = vel_src_rsz_vf(j, k, l, dir_idx(1))
15151
15152 if (chemistry) then
15153
15154# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15155#if defined(MFC_OpenACC)
15156# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15157!$acc loop seq
15158# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15159#elif defined(MFC_OpenMP)
15160# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15161
15162# 3213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15163#endif
15164 do i = chemxb, chemxe
15165 y_l = ql_prim_rsz_vf(j, k, l, i)
15166 y_r = qr_prim_rsz_vf(j + 1, k, l, i)
15167
15168 flux_rsz_vf(j, k, l, &
15169 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15170 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15171 flux_src_rsz_vf(j, k, l, i) = 0.0_wp
15172 end do
15173 end if
15174
15175 ! Geometrical source flux for cylindrical coordinates
15176# 3248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15177# 3249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15178 if (grid_geometry == 3) then
15179
15180# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15181#if defined(MFC_OpenACC)
15182# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15183!$acc loop seq
15184# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15185#elif defined(MFC_OpenMP)
15186# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15187
15188# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15189#endif
15190 do i = 1, sys_size
15191 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
15192 end do
15193
15194 flux_gsrc_rsz_vf(j, k, l, &
15195 & momxb + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1)) &
15196 & + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
15197 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
15198 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
15199 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp &
15200 & - dir_flg(dir_idx(1)))*vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
15201 flux_gsrc_rsz_vf(j, k, l, momxe) = flux_rsz_vf(j, k, l, momxb + 1)
15202 end if
15203# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15204 end do
15205 end do
15206 end do
15207
15208# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15209#if defined(MFC_OpenACC)
15210# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15211!$acc end parallel loop
15212# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15213#elif defined(MFC_OpenMP)
15214# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15215
15216# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15217!$omp end target teams loop
15218# 3268 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15219#endif
15220 end if
15221 end if
15222# 3272 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15223 ! Computing HLLC flux and source flux for Euler system of equations
15224
15225 if (viscous .or. dummy) then
15226 if (weno_re_flux) then
15227 call s_compute_viscous_source_flux(ql_prim_vf(momxb:momxe), dql_prim_dx_vf(momxb:momxe), &
15228 & dql_prim_dy_vf(momxb:momxe), dql_prim_dz_vf(momxb:momxe), &
15229 & qr_prim_vf(momxb:momxe), dqr_prim_dx_vf(momxb:momxe), &
15230 & dqr_prim_dy_vf(momxb:momxe), dqr_prim_dz_vf(momxb:momxe), flux_src_vf, &
15231 & norm_dir, ix, iy, iz)
15232 else
15233 call s_compute_viscous_source_flux(q_prim_vf(momxb:momxe), dql_prim_dx_vf(momxb:momxe), &
15234 & dql_prim_dy_vf(momxb:momxe), dql_prim_dz_vf(momxb:momxe), &
15235 & q_prim_vf(momxb:momxe), dqr_prim_dx_vf(momxb:momxe), &
15236 & dqr_prim_dy_vf(momxb:momxe), dqr_prim_dz_vf(momxb:momxe), flux_src_vf, &
15237 & norm_dir, ix, iy, iz)
15238 end if
15239 end if
15240
15241 if (surface_tension) then
15242 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, &
15243 & isz)
15244 end if
15245
15246 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
15247
15248 end subroutine s_hllc_riemann_solver
15249
15250 !> HLLD Riemann solver for MHD, Miyoshi & Kusano JCP (2005)
15251 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, &
15252
15253 & 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, &
15254 & dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
15255
15256 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, ql_prim_rsy_vf, &
15257 & qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf
15258
15259 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
15260 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
15261
15262 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
15263 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
15264 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
15265 integer, intent(in) :: norm_dir
15266 type(int_bounds_info), intent(in) :: ix, iy, iz
15267
15268 ! Local variables:
15269
15270# 3322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15271 real(wp), dimension(num_fluids) :: alpha_l, alpha_r, alpha_rho_l, alpha_rho_r
15272# 3324 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15273 type(riemann_states_vec3) :: vel
15274 type(riemann_states) :: rho, pres, e, h_no_mag
15275 type(riemann_states) :: gamma, pi_inf, qv
15276 type(riemann_states) :: vel_rms
15277 type(riemann_states_vec3) :: b
15278 type(riemann_states) :: c, c_fast, pres_mag
15279
15280 ! HLLD speeds and intermediate state variables:
15281 real(wp) :: s_l, s_r, s_m, s_starl, s_starr
15282 real(wp) :: ptot_l, ptot_r, p_star, rhol_star, rhor_star, e_starl, e_starr
15283 real(wp), dimension(7) :: u_l, u_r, u_starl, u_starr, u_doublel, u_doubler
15284 real(wp), dimension(7) :: f_l, f_r, f_starl, f_starr, f_hlld
15285
15286 ! 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
15287 ! normal velocity, and x is the normal direction Note: Bx is omitted as the magnetic flux is always zero in the normal
15288 ! direction
15289
15290 real(wp) :: sqrt_rhol_star, sqrt_rhor_star, denom_ds, sign_bx
15291 real(wp) :: vl_star, vr_star, wl_star, wr_star
15292 real(wp) :: v_double, w_double, by_double, bz_double, e_doublel, e_doubler, e_double
15293 integer :: i, j, k, l
15294
15295 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
15296 & 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, &
15297 & dqr_prim_dz_vf, norm_dir, ix, iy, iz)
15298
15299 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
15300
15301# 3353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15302 if (norm_dir == 1) then
15303
15304# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15305
15306# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15307#if defined(MFC_OpenACC)
15308# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15309!$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)
15310# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15311#elif defined(MFC_OpenMP)
15312# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15313
15314# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15315
15316# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15317
15318# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15319!$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)
15320# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15321#endif
15322# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15323 do l = is3%beg, is3%end
15324 do k = is2%beg, is2%end
15325 do j = is1%beg, is1%end
15326 ! (1) Extract the left/right primitive states
15327 do i = 1, contxe
15328 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
15329 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
15330 end do
15331
15332 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
15333 do i = 1, num_vels
15334 vel%L(i) = ql_prim_rsx_vf(j, k, l, contxe + dir_idx(i))
15335 vel%R(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + dir_idx(i))
15336 end do
15337
15338 vel_rms%L = sum(vel%L**2._wp)
15339 vel_rms%R = sum(vel%R**2._wp)
15340
15341 do i = 1, num_fluids
15342 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
15343 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
15344 end do
15345
15346 pres%L = ql_prim_rsx_vf(j, k, l, e_idx)
15347 pres%R = qr_prim_rsx_vf(j + 1, k, l, e_idx)
15348
15349 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
15350 if (mhd) then
15351 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
15352 b%L = [bx0, ql_prim_rsx_vf(j, k, l, b_idx%beg), ql_prim_rsx_vf(j, k, l, &
15353 & b_idx%beg + 1)]
15354 b%R = [bx0, qr_prim_rsx_vf(j + 1, k, l, b_idx%beg), qr_prim_rsx_vf(j + 1, k, l, &
15355 & b_idx%beg + 1)]
15356 else ! 2D/3D: Bx, By, Bz as variables
15357 b%L = [ql_prim_rsx_vf(j, k, l, b_idx%beg + dir_idx(1) - 1), ql_prim_rsx_vf(j, k, &
15358 & l, b_idx%beg + dir_idx(2) - 1), ql_prim_rsx_vf(j, k, l, &
15359 & b_idx%beg + dir_idx(3) - 1)]
15360 b%R = [qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + dir_idx(1) - 1), &
15361 & qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + dir_idx(2) - 1), &
15362 & qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + dir_idx(3) - 1)]
15363 end if
15364 end if
15365
15366 ! Sum properties of all fluid components
15367 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
15368 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
15369
15370# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15371#if defined(MFC_OpenACC)
15372# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15373!$acc loop seq
15374# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15375#elif defined(MFC_OpenMP)
15376# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15377
15378# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15379#endif
15380 do i = 1, num_fluids
15381 rho%L = rho%L + alpha_rho_l(i)
15382 gamma%L = gamma%L + alpha_l(i)*gammas(i)
15383 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
15384 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
15385
15386 rho%R = rho%R + alpha_rho_r(i)
15387 gamma%R = gamma%R + alpha_r(i)*gammas(i)
15388 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
15389 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
15390 end do
15391
15392 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
15393 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
15394 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
15395 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
15396 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
15397 h_no_mag%R = (e%R + pres%R - pres_mag%R) &
15398 & /rho%R ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
15399
15400 ! (2) Compute fast wave speeds
15401 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, &
15402 & 0._wp, c%L, qv%L)
15403 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, &
15404 & 0._wp, c%R, qv%R)
15405 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
15406 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
15407
15408 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
15409 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
15410 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
15411
15412 ptot_l = pres%L + pres_mag%L
15413 ptot_r = pres%R + pres_mag%R
15414
15415 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 &
15416 & - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
15417
15418 ! (4) Compute star state variables
15419 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
15420 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
15421 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
15422 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
15423 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
15424
15425 ! (5) Compute left/right state vectors and fluxes
15426 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
15427 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
15428 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
15429 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
15430
15431 ! Compute the left/right fluxes
15432 f_l(1) = u_l(2)
15433 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
15434 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
15435 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
15436 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))
15437
15438 f_r(1) = u_r(2)
15439 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
15440 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
15441 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
15442 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))
15443 ! HLLD star-state fluxes via HLL jump relation
15444 f_starl = f_l + s_l*(u_starl - u_l)
15445 f_starr = f_r + s_r*(u_starr - u_r)
15446 ! Alfven wave speeds bounding the rotational discontinuities
15447 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
15448 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
15449 ! HLLD double-star (intermediate) states across rotational discontinuities
15450 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
15451 vl_star = vel%L(2); wl_star = vel%L(3)
15452 vr_star = vel%R(2); wr_star = vel%R(3)
15453
15454 ! (6) Compute the double-star states [Miyoshi Eqns. (59)-(62)]
15455 denom_ds = sqrt_rhol_star + sqrt_rhor_star
15456 sign_bx = sign(1._wp, b%L(1))
15457 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
15458 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
15459 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star &
15460 & - vl_star)*sign_bx)/denom_ds
15461 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star &
15462 & - wl_star)*sign_bx)/denom_ds
15463
15464 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double &
15465 & + w_double*bz_double))*sign_bx
15466 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double &
15467 & + w_double*bz_double))*sign_bx
15468 e_double = 0.5_wp*(e_doublel + e_doubler)
15469
15470 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, &
15471 & e_double]
15472 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, &
15473 & e_double]
15474
15475 ! Select HLLD flux region
15476 if (0.0_wp <= s_l) then
15477 f_hlld = f_l
15478 else if (0.0_wp <= s_starl) then
15479 f_hlld = f_l + s_l*(u_starl - u_l)
15480 else if (0.0_wp <= s_m) then
15481 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
15482 else if (0.0_wp <= s_starr) then
15483 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
15484 else if (0.0_wp <= s_r) then
15485 f_hlld = f_r + s_r*(u_starr - u_r)
15486 else
15487 f_hlld = f_r
15488 end if
15489
15490 ! (12) Write HLLD flux to output arrays
15491 flux_rsx_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
15492 ! Momentum
15493 flux_rsx_vf(j, k, l, contxe + dir_idx(1)) = f_hlld(2)
15494 flux_rsx_vf(j, k, l, contxe + dir_idx(2)) = f_hlld(3)
15495 flux_rsx_vf(j, k, l, contxe + dir_idx(3)) = f_hlld(4)
15496 ! Magnetic field
15497 if (n == 0) then
15498 flux_rsx_vf(j, k, l, b_idx%beg) = f_hlld(5)
15499 flux_rsx_vf(j, k, l, b_idx%beg + 1) = f_hlld(6)
15500 else
15501 flux_rsx_vf(j, k, l, b_idx%beg + dir_idx(2) - 1) = f_hlld(5)
15502 flux_rsx_vf(j, k, l, b_idx%beg + dir_idx(3) - 1) = f_hlld(6)
15503 end if
15504 ! Energy
15505 flux_rsx_vf(j, k, l, e_idx) = f_hlld(7)
15506 ! Volume fractions
15507
15508# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15509#if defined(MFC_OpenACC)
15510# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15511!$acc loop seq
15512# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15513#elif defined(MFC_OpenMP)
15514# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15515
15516# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15517#endif
15518 do i = advxb, advxe
15519 flux_rsx_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
15520 end do
15521
15522 flux_src_rsx_vf(j, k, l, advxb) = 0._wp
15523 end do
15524 end do
15525 end do
15526
15527# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15528#if defined(MFC_OpenACC)
15529# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15530!$acc end parallel loop
15531# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15532#elif defined(MFC_OpenMP)
15533# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15534
15535# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15536!$omp end target teams loop
15537# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15538#endif
15539 end if
15540# 3353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15541 if (norm_dir == 2) then
15542
15543# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15544
15545# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15546#if defined(MFC_OpenACC)
15547# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15548!$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)
15549# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15550#elif defined(MFC_OpenMP)
15551# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15552
15553# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15554
15555# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15556
15557# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15558!$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)
15559# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15560#endif
15561# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15562 do l = is3%beg, is3%end
15563 do k = is2%beg, is2%end
15564 do j = is1%beg, is1%end
15565 ! (1) Extract the left/right primitive states
15566 do i = 1, contxe
15567 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
15568 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
15569 end do
15570
15571 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
15572 do i = 1, num_vels
15573 vel%L(i) = ql_prim_rsy_vf(j, k, l, contxe + dir_idx(i))
15574 vel%R(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + dir_idx(i))
15575 end do
15576
15577 vel_rms%L = sum(vel%L**2._wp)
15578 vel_rms%R = sum(vel%R**2._wp)
15579
15580 do i = 1, num_fluids
15581 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
15582 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
15583 end do
15584
15585 pres%L = ql_prim_rsy_vf(j, k, l, e_idx)
15586 pres%R = qr_prim_rsy_vf(j + 1, k, l, e_idx)
15587
15588 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
15589 if (mhd) then
15590 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
15591 b%L = [bx0, ql_prim_rsy_vf(j, k, l, b_idx%beg), ql_prim_rsy_vf(j, k, l, &
15592 & b_idx%beg + 1)]
15593 b%R = [bx0, qr_prim_rsy_vf(j + 1, k, l, b_idx%beg), qr_prim_rsy_vf(j + 1, k, l, &
15594 & b_idx%beg + 1)]
15595 else ! 2D/3D: Bx, By, Bz as variables
15596 b%L = [ql_prim_rsy_vf(j, k, l, b_idx%beg + dir_idx(1) - 1), ql_prim_rsy_vf(j, k, &
15597 & l, b_idx%beg + dir_idx(2) - 1), ql_prim_rsy_vf(j, k, l, &
15598 & b_idx%beg + dir_idx(3) - 1)]
15599 b%R = [qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + dir_idx(1) - 1), &
15600 & qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + dir_idx(2) - 1), &
15601 & qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + dir_idx(3) - 1)]
15602 end if
15603 end if
15604
15605 ! Sum properties of all fluid components
15606 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
15607 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
15608
15609# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15610#if defined(MFC_OpenACC)
15611# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15612!$acc loop seq
15613# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15614#elif defined(MFC_OpenMP)
15615# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15616
15617# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15618#endif
15619 do i = 1, num_fluids
15620 rho%L = rho%L + alpha_rho_l(i)
15621 gamma%L = gamma%L + alpha_l(i)*gammas(i)
15622 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
15623 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
15624
15625 rho%R = rho%R + alpha_rho_r(i)
15626 gamma%R = gamma%R + alpha_r(i)*gammas(i)
15627 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
15628 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
15629 end do
15630
15631 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
15632 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
15633 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
15634 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
15635 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
15636 h_no_mag%R = (e%R + pres%R - pres_mag%R) &
15637 & /rho%R ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
15638
15639 ! (2) Compute fast wave speeds
15640 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, &
15641 & 0._wp, c%L, qv%L)
15642 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, &
15643 & 0._wp, c%R, qv%R)
15644 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
15645 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
15646
15647 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
15648 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
15649 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
15650
15651 ptot_l = pres%L + pres_mag%L
15652 ptot_r = pres%R + pres_mag%R
15653
15654 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 &
15655 & - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
15656
15657 ! (4) Compute star state variables
15658 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
15659 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
15660 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
15661 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
15662 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
15663
15664 ! (5) Compute left/right state vectors and fluxes
15665 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
15666 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
15667 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
15668 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
15669
15670 ! Compute the left/right fluxes
15671 f_l(1) = u_l(2)
15672 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
15673 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
15674 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
15675 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))
15676
15677 f_r(1) = u_r(2)
15678 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
15679 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
15680 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
15681 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))
15682 ! HLLD star-state fluxes via HLL jump relation
15683 f_starl = f_l + s_l*(u_starl - u_l)
15684 f_starr = f_r + s_r*(u_starr - u_r)
15685 ! Alfven wave speeds bounding the rotational discontinuities
15686 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
15687 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
15688 ! HLLD double-star (intermediate) states across rotational discontinuities
15689 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
15690 vl_star = vel%L(2); wl_star = vel%L(3)
15691 vr_star = vel%R(2); wr_star = vel%R(3)
15692
15693 ! (6) Compute the double-star states [Miyoshi Eqns. (59)-(62)]
15694 denom_ds = sqrt_rhol_star + sqrt_rhor_star
15695 sign_bx = sign(1._wp, b%L(1))
15696 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
15697 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
15698 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star &
15699 & - vl_star)*sign_bx)/denom_ds
15700 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star &
15701 & - wl_star)*sign_bx)/denom_ds
15702
15703 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double &
15704 & + w_double*bz_double))*sign_bx
15705 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double &
15706 & + w_double*bz_double))*sign_bx
15707 e_double = 0.5_wp*(e_doublel + e_doubler)
15708
15709 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, &
15710 & e_double]
15711 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, &
15712 & e_double]
15713
15714 ! Select HLLD flux region
15715 if (0.0_wp <= s_l) then
15716 f_hlld = f_l
15717 else if (0.0_wp <= s_starl) then
15718 f_hlld = f_l + s_l*(u_starl - u_l)
15719 else if (0.0_wp <= s_m) then
15720 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
15721 else if (0.0_wp <= s_starr) then
15722 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
15723 else if (0.0_wp <= s_r) then
15724 f_hlld = f_r + s_r*(u_starr - u_r)
15725 else
15726 f_hlld = f_r
15727 end if
15728
15729 ! (12) Write HLLD flux to output arrays
15730 flux_rsy_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
15731 ! Momentum
15732 flux_rsy_vf(j, k, l, contxe + dir_idx(1)) = f_hlld(2)
15733 flux_rsy_vf(j, k, l, contxe + dir_idx(2)) = f_hlld(3)
15734 flux_rsy_vf(j, k, l, contxe + dir_idx(3)) = f_hlld(4)
15735 ! Magnetic field
15736 if (n == 0) then
15737 flux_rsy_vf(j, k, l, b_idx%beg) = f_hlld(5)
15738 flux_rsy_vf(j, k, l, b_idx%beg + 1) = f_hlld(6)
15739 else
15740 flux_rsy_vf(j, k, l, b_idx%beg + dir_idx(2) - 1) = f_hlld(5)
15741 flux_rsy_vf(j, k, l, b_idx%beg + dir_idx(3) - 1) = f_hlld(6)
15742 end if
15743 ! Energy
15744 flux_rsy_vf(j, k, l, e_idx) = f_hlld(7)
15745 ! Volume fractions
15746
15747# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15748#if defined(MFC_OpenACC)
15749# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15750!$acc loop seq
15751# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15752#elif defined(MFC_OpenMP)
15753# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15754
15755# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15756#endif
15757 do i = advxb, advxe
15758 flux_rsy_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
15759 end do
15760
15761 flux_src_rsy_vf(j, k, l, advxb) = 0._wp
15762 end do
15763 end do
15764 end do
15765
15766# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15767#if defined(MFC_OpenACC)
15768# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15769!$acc end parallel loop
15770# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15771#elif defined(MFC_OpenMP)
15772# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15773
15774# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15775!$omp end target teams loop
15776# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15777#endif
15778 end if
15779# 3353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15780 if (norm_dir == 3) then
15781
15782# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15783
15784# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15785#if defined(MFC_OpenACC)
15786# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15787!$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)
15788# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15789#elif defined(MFC_OpenMP)
15790# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15791
15792# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15793
15794# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15795
15796# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15797!$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)
15798# 3354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15799#endif
15800# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15801 do l = is3%beg, is3%end
15802 do k = is2%beg, is2%end
15803 do j = is1%beg, is1%end
15804 ! (1) Extract the left/right primitive states
15805 do i = 1, contxe
15806 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
15807 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
15808 end do
15809
15810 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
15811 do i = 1, num_vels
15812 vel%L(i) = ql_prim_rsz_vf(j, k, l, contxe + dir_idx(i))
15813 vel%R(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + dir_idx(i))
15814 end do
15815
15816 vel_rms%L = sum(vel%L**2._wp)
15817 vel_rms%R = sum(vel%R**2._wp)
15818
15819 do i = 1, num_fluids
15820 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
15821 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
15822 end do
15823
15824 pres%L = ql_prim_rsz_vf(j, k, l, e_idx)
15825 pres%R = qr_prim_rsz_vf(j + 1, k, l, e_idx)
15826
15827 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
15828 if (mhd) then
15829 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
15830 b%L = [bx0, ql_prim_rsz_vf(j, k, l, b_idx%beg), ql_prim_rsz_vf(j, k, l, &
15831 & b_idx%beg + 1)]
15832 b%R = [bx0, qr_prim_rsz_vf(j + 1, k, l, b_idx%beg), qr_prim_rsz_vf(j + 1, k, l, &
15833 & b_idx%beg + 1)]
15834 else ! 2D/3D: Bx, By, Bz as variables
15835 b%L = [ql_prim_rsz_vf(j, k, l, b_idx%beg + dir_idx(1) - 1), ql_prim_rsz_vf(j, k, &
15836 & l, b_idx%beg + dir_idx(2) - 1), ql_prim_rsz_vf(j, k, l, &
15837 & b_idx%beg + dir_idx(3) - 1)]
15838 b%R = [qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + dir_idx(1) - 1), &
15839 & qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + dir_idx(2) - 1), &
15840 & qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + dir_idx(3) - 1)]
15841 end if
15842 end if
15843
15844 ! Sum properties of all fluid components
15845 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
15846 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
15847
15848# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15849#if defined(MFC_OpenACC)
15850# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15851!$acc loop seq
15852# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15853#elif defined(MFC_OpenMP)
15854# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15855
15856# 3406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15857#endif
15858 do i = 1, num_fluids
15859 rho%L = rho%L + alpha_rho_l(i)
15860 gamma%L = gamma%L + alpha_l(i)*gammas(i)
15861 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
15862 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
15863
15864 rho%R = rho%R + alpha_rho_r(i)
15865 gamma%R = gamma%R + alpha_r(i)*gammas(i)
15866 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
15867 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
15868 end do
15869
15870 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
15871 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
15872 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
15873 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
15874 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
15875 h_no_mag%R = (e%R + pres%R - pres_mag%R) &
15876 & /rho%R ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
15877
15878 ! (2) Compute fast wave speeds
15879 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, &
15880 & 0._wp, c%L, qv%L)
15881 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, &
15882 & 0._wp, c%R, qv%R)
15883 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
15884 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
15885
15886 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
15887 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
15888 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
15889
15890 ptot_l = pres%L + pres_mag%L
15891 ptot_r = pres%R + pres_mag%R
15892
15893 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 &
15894 & - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
15895
15896 ! (4) Compute star state variables
15897 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
15898 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
15899 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
15900 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
15901 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
15902
15903 ! (5) Compute left/right state vectors and fluxes
15904 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
15905 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
15906 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
15907 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
15908
15909 ! Compute the left/right fluxes
15910 f_l(1) = u_l(2)
15911 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
15912 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
15913 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
15914 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))
15915
15916 f_r(1) = u_r(2)
15917 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
15918 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
15919 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
15920 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))
15921 ! HLLD star-state fluxes via HLL jump relation
15922 f_starl = f_l + s_l*(u_starl - u_l)
15923 f_starr = f_r + s_r*(u_starr - u_r)
15924 ! Alfven wave speeds bounding the rotational discontinuities
15925 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
15926 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
15927 ! HLLD double-star (intermediate) states across rotational discontinuities
15928 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
15929 vl_star = vel%L(2); wl_star = vel%L(3)
15930 vr_star = vel%R(2); wr_star = vel%R(3)
15931
15932 ! (6) Compute the double-star states [Miyoshi Eqns. (59)-(62)]
15933 denom_ds = sqrt_rhol_star + sqrt_rhor_star
15934 sign_bx = sign(1._wp, b%L(1))
15935 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
15936 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
15937 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star &
15938 & - vl_star)*sign_bx)/denom_ds
15939 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star &
15940 & - wl_star)*sign_bx)/denom_ds
15941
15942 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double &
15943 & + w_double*bz_double))*sign_bx
15944 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double &
15945 & + w_double*bz_double))*sign_bx
15946 e_double = 0.5_wp*(e_doublel + e_doubler)
15947
15948 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, &
15949 & e_double]
15950 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, &
15951 & e_double]
15952
15953 ! Select HLLD flux region
15954 if (0.0_wp <= s_l) then
15955 f_hlld = f_l
15956 else if (0.0_wp <= s_starl) then
15957 f_hlld = f_l + s_l*(u_starl - u_l)
15958 else if (0.0_wp <= s_m) then
15959 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
15960 else if (0.0_wp <= s_starr) then
15961 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
15962 else if (0.0_wp <= s_r) then
15963 f_hlld = f_r + s_r*(u_starr - u_r)
15964 else
15965 f_hlld = f_r
15966 end if
15967
15968 ! (12) Write HLLD flux to output arrays
15969 flux_rsz_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
15970 ! Momentum
15971 flux_rsz_vf(j, k, l, contxe + dir_idx(1)) = f_hlld(2)
15972 flux_rsz_vf(j, k, l, contxe + dir_idx(2)) = f_hlld(3)
15973 flux_rsz_vf(j, k, l, contxe + dir_idx(3)) = f_hlld(4)
15974 ! Magnetic field
15975 if (n == 0) then
15976 flux_rsz_vf(j, k, l, b_idx%beg) = f_hlld(5)
15977 flux_rsz_vf(j, k, l, b_idx%beg + 1) = f_hlld(6)
15978 else
15979 flux_rsz_vf(j, k, l, b_idx%beg + dir_idx(2) - 1) = f_hlld(5)
15980 flux_rsz_vf(j, k, l, b_idx%beg + dir_idx(3) - 1) = f_hlld(6)
15981 end if
15982 ! Energy
15983 flux_rsz_vf(j, k, l, e_idx) = f_hlld(7)
15984 ! Volume fractions
15985
15986# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15987#if defined(MFC_OpenACC)
15988# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15989!$acc loop seq
15990# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15991#elif defined(MFC_OpenMP)
15992# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15993
15994# 3534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15995#endif
15996 do i = advxb, advxe
15997 flux_rsz_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
15998 end do
15999
16000 flux_src_rsz_vf(j, k, l, advxb) = 0._wp
16001 end do
16002 end do
16003 end do
16004
16005# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16006#if defined(MFC_OpenACC)
16007# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16008!$acc end parallel loop
16009# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16010#elif defined(MFC_OpenMP)
16011# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16012
16013# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16014!$omp end target teams loop
16015# 3543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16016#endif
16017 end if
16018# 3546 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16019
16020 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
16021
16022 end subroutine s_hlld_riemann_solver
16023
16024 !> Initialize the Riemann solvers module
16025 impure subroutine s_initialize_riemann_solvers_module
16026
16027 ! Allocating the variables that will be utilized to formulate the left, right, and average states of the Riemann problem, as
16028 ! well the Riemann problem solution
16029 integer :: i, j
16030
16031#ifdef MFC_DEBUG
16032# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16033 block
16034# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16035 use iso_fortran_env, only: output_unit
16036# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16037
16038# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16039 print *, 'm_riemann_solvers.fpp:3558: ', '@:ALLOCATE(Gs_rs(1:num_fluids))'
16040# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16041
16042# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16043 call flush (output_unit)
16044# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16045 end block
16046# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16047#endif
16048# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16049 allocate (gs_rs(1:num_fluids))
16050# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16051
16052# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16053
16054# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16055#if defined(MFC_OpenACC)
16056# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16057!$acc enter data create(Gs_rs)
16058# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16059#elif defined(MFC_OpenMP)
16060# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16061!$omp target enter data map(always,alloc:Gs_rs)
16062# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16063#endif
16064
16065 do i = 1, num_fluids
16066 gs_rs(i) = fluid_pp(i)%G
16067 end do
16068
16069# 3563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16070#if defined(MFC_OpenACC)
16071# 3563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16072!$acc update device(Gs_rs)
16073# 3563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16074#elif defined(MFC_OpenMP)
16075# 3563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16076!$omp target update to(Gs_rs)
16077# 3563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16078#endif
16079
16080 if (viscous) then
16081#ifdef MFC_DEBUG
16082# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16083 block
16084# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16085 use iso_fortran_env, only: output_unit
16086# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16087
16088# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16089 print *, 'm_riemann_solvers.fpp:3566: ', '@:ALLOCATE(Res_gs(1:2, 1:Re_size_max))'
16090# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16091
16092# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16093 call flush (output_unit)
16094# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16095 end block
16096# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16097#endif
16098# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16099 allocate (res_gs(1:2, 1:re_size_max))
16100# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16101
16102# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16103
16104# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16105#if defined(MFC_OpenACC)
16106# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16107!$acc enter data create(Res_gs)
16108# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16109#elif defined(MFC_OpenMP)
16110# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16111!$omp target enter data map(always,alloc:Res_gs)
16112# 3566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16113#endif
16114 end if
16115
16116 if (viscous) then
16117 do i = 1, 2
16118 do j = 1, re_size(i)
16119 res_gs(i, j) = fluid_pp(re_idx(i, j))%Re(i)
16120 end do
16121 end do
16122
16123# 3575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16124#if defined(MFC_OpenACC)
16125# 3575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16126!$acc update device(Res_gs, Re_idx, Re_size)
16127# 3575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16128#elif defined(MFC_OpenMP)
16129# 3575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16130!$omp target update to(Res_gs, Re_idx, Re_size)
16131# 3575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16132#endif
16133 end if
16134
16135
16136# 3578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16137#if defined(MFC_OpenACC)
16138# 3578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16139!$acc enter data copyin(is1, is2, is3, isx, isy, isz)
16140# 3578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16141#elif defined(MFC_OpenMP)
16142# 3578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16143!$omp target enter data map(to:is1, is2, is3, isx, isy, isz)
16144# 3578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16145#endif
16146
16147 is1%beg = -1; is2%beg = 0; is3%beg = 0
16148 is1%end = m; is2%end = n; is3%end = p
16149
16150#ifdef MFC_DEBUG
16151# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16152 block
16153# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16154 use iso_fortran_env, only: output_unit
16155# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16156
16157# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16158 print *, 'm_riemann_solvers.fpp:3583: ', '@:ALLOCATE(flux_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
16159# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16160
16161# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16162 call flush (output_unit)
16163# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16164 end block
16165# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16166#endif
16167# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16168 allocate (flux_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
16169# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16170
16171# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16172
16173# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16174#if defined(MFC_OpenACC)
16175# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16176!$acc enter data create(flux_rsx_vf)
16177# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16178#elif defined(MFC_OpenMP)
16179# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16180!$omp target enter data map(always,alloc:flux_rsx_vf)
16181# 3583 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16182#endif
16183#ifdef MFC_DEBUG
16184# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16185 block
16186# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16187 use iso_fortran_env, only: output_unit
16188# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16189
16190# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16191 print *, 'm_riemann_solvers.fpp:3584: ', '@:ALLOCATE(flux_gsrc_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
16192# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16193
16194# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16195 call flush (output_unit)
16196# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16197 end block
16198# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16199#endif
16200# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16201 allocate (flux_gsrc_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
16202# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16203
16204# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16205
16206# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16207#if defined(MFC_OpenACC)
16208# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16209!$acc enter data create(flux_gsrc_rsx_vf)
16210# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16211#elif defined(MFC_OpenMP)
16212# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16213!$omp target enter data map(always,alloc:flux_gsrc_rsx_vf)
16214# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16215#endif
16216#ifdef MFC_DEBUG
16217# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16218 block
16219# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16220 use iso_fortran_env, only: output_unit
16221# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16222
16223# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16224 print *, 'm_riemann_solvers.fpp:3585: ', '@:ALLOCATE(flux_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))'
16225# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16226
16227# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16228 call flush (output_unit)
16229# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16230 end block
16231# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16232#endif
16233# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16234 allocate (flux_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))
16235# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16236
16237# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16238
16239# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16240#if defined(MFC_OpenACC)
16241# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16242!$acc enter data create(flux_src_rsx_vf)
16243# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16244#elif defined(MFC_OpenMP)
16245# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16246!$omp target enter data map(always,alloc:flux_src_rsx_vf)
16247# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16248#endif
16249#ifdef MFC_DEBUG
16250# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16251 block
16252# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16253 use iso_fortran_env, only: output_unit
16254# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16255
16256# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16257 print *, 'm_riemann_solvers.fpp:3586: ', '@:ALLOCATE(vel_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))'
16258# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16259
16260# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16261 call flush (output_unit)
16262# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16263 end block
16264# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16265#endif
16266# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16267 allocate (vel_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))
16268# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16269
16270# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16271
16272# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16273#if defined(MFC_OpenACC)
16274# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16275!$acc enter data create(vel_src_rsx_vf)
16276# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16277#elif defined(MFC_OpenMP)
16278# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16279!$omp target enter data map(always,alloc:vel_src_rsx_vf)
16280# 3586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16281#endif
16282 if (qbmm) then
16283#ifdef MFC_DEBUG
16284# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16285 block
16286# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16287 use iso_fortran_env, only: output_unit
16288# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16289
16290# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16291 print *, 'm_riemann_solvers.fpp:3588: ', '@:ALLOCATE(mom_sp_rsx_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))'
16292# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16293
16294# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16295 call flush (output_unit)
16296# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16297 end block
16298# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16299#endif
16300# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16301 allocate (mom_sp_rsx_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))
16302# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16303
16304# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16305
16306# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16307#if defined(MFC_OpenACC)
16308# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16309!$acc enter data create(mom_sp_rsx_vf)
16310# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16311#elif defined(MFC_OpenMP)
16312# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16313!$omp target enter data map(always,alloc:mom_sp_rsx_vf)
16314# 3588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16315#endif
16316 end if
16317
16318 if (viscous) then
16319#ifdef MFC_DEBUG
16320# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16321 block
16322# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16323 use iso_fortran_env, only: output_unit
16324# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16325
16326# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16327 print *, 'm_riemann_solvers.fpp:3592: ', '@:ALLOCATE(Re_avg_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))'
16328# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16329
16330# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16331 call flush (output_unit)
16332# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16333 end block
16334# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16335#endif
16336# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16337 allocate (re_avg_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))
16338# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16339
16340# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16341
16342# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16343#if defined(MFC_OpenACC)
16344# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16345!$acc enter data create(Re_avg_rsx_vf)
16346# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16347#elif defined(MFC_OpenMP)
16348# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16349!$omp target enter data map(always,alloc:Re_avg_rsx_vf)
16350# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16351#endif
16352 end if
16353
16354 if (n == 0) return
16355
16356 is1%beg = -1; is2%beg = 0; is3%beg = 0
16357 is1%end = n; is2%end = m; is3%end = p
16358
16359#ifdef MFC_DEBUG
16360# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16361 block
16362# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16363 use iso_fortran_env, only: output_unit
16364# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16365
16366# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16367 print *, 'm_riemann_solvers.fpp:3600: ', '@:ALLOCATE(flux_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
16368# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16369
16370# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16371 call flush (output_unit)
16372# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16373 end block
16374# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16375#endif
16376# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16377 allocate (flux_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
16378# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16379
16380# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16381
16382# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16383#if defined(MFC_OpenACC)
16384# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16385!$acc enter data create(flux_rsy_vf)
16386# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16387#elif defined(MFC_OpenMP)
16388# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16389!$omp target enter data map(always,alloc:flux_rsy_vf)
16390# 3600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16391#endif
16392#ifdef MFC_DEBUG
16393# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16394 block
16395# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16396 use iso_fortran_env, only: output_unit
16397# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16398
16399# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16400 print *, 'm_riemann_solvers.fpp:3601: ', '@:ALLOCATE(flux_gsrc_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
16401# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16402
16403# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16404 call flush (output_unit)
16405# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16406 end block
16407# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16408#endif
16409# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16410 allocate (flux_gsrc_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
16411# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16412
16413# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16414
16415# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16416#if defined(MFC_OpenACC)
16417# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16418!$acc enter data create(flux_gsrc_rsy_vf)
16419# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16420#elif defined(MFC_OpenMP)
16421# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16422!$omp target enter data map(always,alloc:flux_gsrc_rsy_vf)
16423# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16424#endif
16425#ifdef MFC_DEBUG
16426# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16427 block
16428# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16429 use iso_fortran_env, only: output_unit
16430# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16431
16432# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16433 print *, 'm_riemann_solvers.fpp:3602: ', '@:ALLOCATE(flux_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))'
16434# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16435
16436# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16437 call flush (output_unit)
16438# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16439 end block
16440# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16441#endif
16442# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16443 allocate (flux_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))
16444# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16445
16446# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16447
16448# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16449#if defined(MFC_OpenACC)
16450# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16451!$acc enter data create(flux_src_rsy_vf)
16452# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16453#elif defined(MFC_OpenMP)
16454# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16455!$omp target enter data map(always,alloc:flux_src_rsy_vf)
16456# 3602 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16457#endif
16458#ifdef MFC_DEBUG
16459# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16460 block
16461# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16462 use iso_fortran_env, only: output_unit
16463# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16464
16465# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16466 print *, 'm_riemann_solvers.fpp:3603: ', '@:ALLOCATE(vel_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))'
16467# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16468
16469# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16470 call flush (output_unit)
16471# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16472 end block
16473# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16474#endif
16475# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16476 allocate (vel_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))
16477# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16478
16479# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16480
16481# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16482#if defined(MFC_OpenACC)
16483# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16484!$acc enter data create(vel_src_rsy_vf)
16485# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16486#elif defined(MFC_OpenMP)
16487# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16488!$omp target enter data map(always,alloc:vel_src_rsy_vf)
16489# 3603 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16490#endif
16491
16492 if (qbmm) then
16493#ifdef MFC_DEBUG
16494# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16495 block
16496# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16497 use iso_fortran_env, only: output_unit
16498# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16499
16500# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16501 print *, 'm_riemann_solvers.fpp:3606: ', '@:ALLOCATE(mom_sp_rsy_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))'
16502# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16503
16504# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16505 call flush (output_unit)
16506# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16507 end block
16508# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16509#endif
16510# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16511 allocate (mom_sp_rsy_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))
16512# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16513
16514# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16515
16516# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16517#if defined(MFC_OpenACC)
16518# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16519!$acc enter data create(mom_sp_rsy_vf)
16520# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16521#elif defined(MFC_OpenMP)
16522# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16523!$omp target enter data map(always,alloc:mom_sp_rsy_vf)
16524# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16525#endif
16526 end if
16527
16528 if (viscous) then
16529#ifdef MFC_DEBUG
16530# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16531 block
16532# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16533 use iso_fortran_env, only: output_unit
16534# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16535
16536# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16537 print *, 'm_riemann_solvers.fpp:3610: ', '@:ALLOCATE(Re_avg_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))'
16538# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16539
16540# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16541 call flush (output_unit)
16542# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16543 end block
16544# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16545#endif
16546# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16547 allocate (re_avg_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))
16548# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16549
16550# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16551
16552# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16553#if defined(MFC_OpenACC)
16554# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16555!$acc enter data create(Re_avg_rsy_vf)
16556# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16557#elif defined(MFC_OpenMP)
16558# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16559!$omp target enter data map(always,alloc:Re_avg_rsy_vf)
16560# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16561#endif
16562 end if
16563
16564 if (p == 0) return
16565
16566 is1%beg = -1; is2%beg = 0; is3%beg = 0
16567 is1%end = p; is2%end = n; is3%end = m
16568
16569#ifdef MFC_DEBUG
16570# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16571 block
16572# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16573 use iso_fortran_env, only: output_unit
16574# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16575
16576# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16577 print *, 'm_riemann_solvers.fpp:3618: ', '@:ALLOCATE(flux_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
16578# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16579
16580# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16581 call flush (output_unit)
16582# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16583 end block
16584# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16585#endif
16586# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16587 allocate (flux_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
16588# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16589
16590# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16591
16592# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16593#if defined(MFC_OpenACC)
16594# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16595!$acc enter data create(flux_rsz_vf)
16596# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16597#elif defined(MFC_OpenMP)
16598# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16599!$omp target enter data map(always,alloc:flux_rsz_vf)
16600# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16601#endif
16602#ifdef MFC_DEBUG
16603# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16604 block
16605# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16606 use iso_fortran_env, only: output_unit
16607# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16608
16609# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16610 print *, 'm_riemann_solvers.fpp:3619: ', '@:ALLOCATE(flux_gsrc_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
16611# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16612
16613# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16614 call flush (output_unit)
16615# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16616 end block
16617# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16618#endif
16619# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16620 allocate (flux_gsrc_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
16621# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16622
16623# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16624
16625# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16626#if defined(MFC_OpenACC)
16627# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16628!$acc enter data create(flux_gsrc_rsz_vf)
16629# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16630#elif defined(MFC_OpenMP)
16631# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16632!$omp target enter data map(always,alloc:flux_gsrc_rsz_vf)
16633# 3619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16634#endif
16635#ifdef MFC_DEBUG
16636# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16637 block
16638# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16639 use iso_fortran_env, only: output_unit
16640# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16641
16642# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16643 print *, 'm_riemann_solvers.fpp:3620: ', '@:ALLOCATE(flux_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))'
16644# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16645
16646# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16647 call flush (output_unit)
16648# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16649 end block
16650# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16651#endif
16652# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16653 allocate (flux_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))
16654# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16655
16656# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16657
16658# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16659#if defined(MFC_OpenACC)
16660# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16661!$acc enter data create(flux_src_rsz_vf)
16662# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16663#elif defined(MFC_OpenMP)
16664# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16665!$omp target enter data map(always,alloc:flux_src_rsz_vf)
16666# 3620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16667#endif
16668#ifdef MFC_DEBUG
16669# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16670 block
16671# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16672 use iso_fortran_env, only: output_unit
16673# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16674
16675# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16676 print *, 'm_riemann_solvers.fpp:3621: ', '@:ALLOCATE(vel_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))'
16677# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16678
16679# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16680 call flush (output_unit)
16681# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16682 end block
16683# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16684#endif
16685# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16686 allocate (vel_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))
16687# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16688
16689# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16690
16691# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16692#if defined(MFC_OpenACC)
16693# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16694!$acc enter data create(vel_src_rsz_vf)
16695# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16696#elif defined(MFC_OpenMP)
16697# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16698!$omp target enter data map(always,alloc:vel_src_rsz_vf)
16699# 3621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16700#endif
16701
16702 if (qbmm) then
16703#ifdef MFC_DEBUG
16704# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16705 block
16706# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16707 use iso_fortran_env, only: output_unit
16708# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16709
16710# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16711 print *, 'm_riemann_solvers.fpp:3624: ', '@:ALLOCATE(mom_sp_rsz_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))'
16712# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16713
16714# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16715 call flush (output_unit)
16716# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16717 end block
16718# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16719#endif
16720# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16721 allocate (mom_sp_rsz_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))
16722# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16723
16724# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16725
16726# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16727#if defined(MFC_OpenACC)
16728# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16729!$acc enter data create(mom_sp_rsz_vf)
16730# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16731#elif defined(MFC_OpenMP)
16732# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16733!$omp target enter data map(always,alloc:mom_sp_rsz_vf)
16734# 3624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16735#endif
16736 end if
16737
16738 if (viscous) then
16739#ifdef MFC_DEBUG
16740# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16741 block
16742# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16743 use iso_fortran_env, only: output_unit
16744# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16745
16746# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16747 print *, 'm_riemann_solvers.fpp:3628: ', '@:ALLOCATE(Re_avg_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))'
16748# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16749
16750# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16751 call flush (output_unit)
16752# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16753 end block
16754# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16755#endif
16756# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16757 allocate (re_avg_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))
16758# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16759
16760# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16761
16762# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16763#if defined(MFC_OpenACC)
16764# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16765!$acc enter data create(Re_avg_rsz_vf)
16766# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16767#elif defined(MFC_OpenMP)
16768# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16769!$omp target enter data map(always,alloc:Re_avg_rsz_vf)
16770# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16771#endif
16772 end if
16773
16774 end subroutine s_initialize_riemann_solvers_module
16775
16776 !> Populate the left and right Riemann state variable buffers based on boundary conditions
16777 subroutine s_populate_riemann_states_variables_buffers(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, &
16778
16779 & 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, &
16780 & dqR_prim_dz_vf, norm_dir, ix, iy, iz)
16781
16782 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, &
16783 & qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf
16784
16785 type(scalar_field), allocatable, dimension(:), intent(inout) :: dqL_prim_dx_vf, dqR_prim_dx_vf, dqL_prim_dy_vf, &
16786 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
16787
16788 integer, intent(in) :: norm_dir
16789 type(int_bounds_info), intent(in) :: ix, iy, iz
16790 integer :: i, j, k, l !< Generic loop iterator
16791
16792 if (norm_dir == 1) then
16793 is1 = ix; is2 = iy; is3 = iz
16794 dir_idx = (/1, 2, 3/); dir_flg = (/1._wp, 0._wp, 0._wp/)
16795 else if (norm_dir == 2) then
16796 is1 = iy; is2 = ix; is3 = iz
16797 dir_idx = (/2, 1, 3/); dir_flg = (/0._wp, 1._wp, 0._wp/)
16798 else
16799 is1 = iz; is2 = iy; is3 = ix
16800 dir_idx = (/3, 1, 2/); dir_flg = (/0._wp, 0._wp, 1._wp/)
16801 end if
16802
16803
16804# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16805#if defined(MFC_OpenACC)
16806# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16807!$acc update device(is1, is2, is3)
16808# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16809#elif defined(MFC_OpenMP)
16810# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16811!$omp target update to(is1, is2, is3)
16812# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16813#endif
16814
16815 if (elasticity) then
16816 if (norm_dir == 1) then
16817 dir_idx_tau = (/1, 2, 4/)
16818 else if (norm_dir == 2) then
16819 dir_idx_tau = (/3, 2, 5/)
16820 else
16821 dir_idx_tau = (/6, 4, 5/)
16822 end if
16823 end if
16824
16825 isx = ix; isy = iy; isz = iz
16826 ! for stuff in the same module
16827
16828# 3674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16829#if defined(MFC_OpenACC)
16830# 3674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16831!$acc update device(isx, isy, isz)
16832# 3674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16833#elif defined(MFC_OpenMP)
16834# 3674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16835!$omp target update to(isx, isy, isz)
16836# 3674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16837#endif
16838 ! for stuff in different modules
16839
16840# 3676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16841#if defined(MFC_OpenACC)
16842# 3676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16843!$acc update device(dir_idx, dir_flg, dir_idx_tau)
16844# 3676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16845#elif defined(MFC_OpenMP)
16846# 3676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16847!$omp target update to(dir_idx, dir_flg, dir_idx_tau)
16848# 3676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16849#endif
16850
16851 ! Population of Buffers in x-direction
16852 if (norm_dir == 1) then
16853 if (bc_x%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
16854
16855# 3681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16856
16857# 3681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16858#if defined(MFC_OpenACC)
16859# 3681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16860!$acc parallel loop collapse(3) gang vector default(present)
16861# 3681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16862#elif defined(MFC_OpenMP)
16863# 3681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16864
16865# 3681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16866
16867# 3681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16868
16869# 3681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16870!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16871# 3681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16872#endif
16873 do i = 1, sys_size
16874 do l = is3%beg, is3%end
16875 do k = is2%beg, is2%end
16876 ql_prim_rsx_vf(-1, k, l, i) = qr_prim_rsx_vf(0, k, l, i)
16877 end do
16878 end do
16879 end do
16880
16881# 3689 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16882#if defined(MFC_OpenACC)
16883# 3689 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16884!$acc end parallel loop
16885# 3689 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16886#elif defined(MFC_OpenMP)
16887# 3689 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16888
16889# 3689 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16890!$omp end target teams loop
16891# 3689 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16892#endif
16893
16894 if (viscous .or. dummy) then
16895
16896# 3692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16897
16898# 3692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16899#if defined(MFC_OpenACC)
16900# 3692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16901!$acc parallel loop collapse(3) gang vector default(present)
16902# 3692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16903#elif defined(MFC_OpenMP)
16904# 3692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16905
16906# 3692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16907
16908# 3692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16909
16910# 3692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16911!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16912# 3692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16913#endif
16914 do i = momxb, momxe
16915 do l = isz%beg, isz%end
16916 do k = isy%beg, isy%end
16917 dql_prim_dx_vf(i)%sf(-1, k, l) = dqr_prim_dx_vf(i)%sf(0, k, l)
16918 end do
16919 end do
16920 end do
16921
16922# 3700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16923#if defined(MFC_OpenACC)
16924# 3700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16925!$acc end parallel loop
16926# 3700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16927#elif defined(MFC_OpenMP)
16928# 3700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16929
16930# 3700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16931!$omp end target teams loop
16932# 3700 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16933#endif
16934
16935 if (n > 0) then
16936
16937# 3703 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16938
16939# 3703 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16940#if defined(MFC_OpenACC)
16941# 3703 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16942!$acc parallel loop collapse(3) gang vector default(present)
16943# 3703 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16944#elif defined(MFC_OpenMP)
16945# 3703 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16946
16947# 3703 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16948
16949# 3703 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16950
16951# 3703 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16952!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16953# 3703 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16954#endif
16955 do i = momxb, momxe
16956 do l = isz%beg, isz%end
16957 do k = isy%beg, isy%end
16958 dql_prim_dy_vf(i)%sf(-1, k, l) = dqr_prim_dy_vf(i)%sf(0, k, l)
16959 end do
16960 end do
16961 end do
16962
16963# 3711 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16964#if defined(MFC_OpenACC)
16965# 3711 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16966!$acc end parallel loop
16967# 3711 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16968#elif defined(MFC_OpenMP)
16969# 3711 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16970
16971# 3711 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16972!$omp end target teams loop
16973# 3711 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16974#endif
16975
16976 if (p > 0) then
16977
16978# 3714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16979
16980# 3714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16981#if defined(MFC_OpenACC)
16982# 3714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16983!$acc parallel loop collapse(3) gang vector default(present)
16984# 3714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16985#elif defined(MFC_OpenMP)
16986# 3714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16987
16988# 3714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16989
16990# 3714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16991
16992# 3714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16993!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16994# 3714 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16995#endif
16996 do i = momxb, momxe
16997 do l = isz%beg, isz%end
16998 do k = isy%beg, isy%end
16999 dql_prim_dz_vf(i)%sf(-1, k, l) = dqr_prim_dz_vf(i)%sf(0, k, l)
17000 end do
17001 end do
17002 end do
17003
17004# 3722 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17005#if defined(MFC_OpenACC)
17006# 3722 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17007!$acc end parallel loop
17008# 3722 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17009#elif defined(MFC_OpenMP)
17010# 3722 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17011
17012# 3722 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17013!$omp end target teams loop
17014# 3722 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17015#endif
17016 end if
17017 end if
17018 end if
17019 end if
17020
17021 if (bc_x%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
17022
17023
17024# 3730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17025
17026# 3730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17027#if defined(MFC_OpenACC)
17028# 3730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17029!$acc parallel loop collapse(3) gang vector default(present)
17030# 3730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17031#elif defined(MFC_OpenMP)
17032# 3730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17033
17034# 3730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17035
17036# 3730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17037
17038# 3730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17039!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17040# 3730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17041#endif
17042 do i = 1, sys_size
17043 do l = is3%beg, is3%end
17044 do k = is2%beg, is2%end
17045 qr_prim_rsx_vf(m + 1, k, l, i) = ql_prim_rsx_vf(m, k, l, i)
17046 end do
17047 end do
17048 end do
17049
17050# 3738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17051#if defined(MFC_OpenACC)
17052# 3738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17053!$acc end parallel loop
17054# 3738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17055#elif defined(MFC_OpenMP)
17056# 3738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17057
17058# 3738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17059!$omp end target teams loop
17060# 3738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17061#endif
17062
17063 if (viscous .or. dummy) then
17064
17065# 3741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17066
17067# 3741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17068#if defined(MFC_OpenACC)
17069# 3741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17070!$acc parallel loop collapse(3) gang vector default(present)
17071# 3741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17072#elif defined(MFC_OpenMP)
17073# 3741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17074
17075# 3741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17076
17077# 3741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17078
17079# 3741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17080!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17081# 3741 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17082#endif
17083 do i = momxb, momxe
17084 do l = isz%beg, isz%end
17085 do k = isy%beg, isy%end
17086 dqr_prim_dx_vf(i)%sf(m + 1, k, l) = dql_prim_dx_vf(i)%sf(m, k, l)
17087 end do
17088 end do
17089 end do
17090
17091# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17092#if defined(MFC_OpenACC)
17093# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17094!$acc end parallel loop
17095# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17096#elif defined(MFC_OpenMP)
17097# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17098
17099# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17100!$omp end target teams loop
17101# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17102#endif
17103
17104 if (n > 0) then
17105
17106# 3752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17107
17108# 3752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17109#if defined(MFC_OpenACC)
17110# 3752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17111!$acc parallel loop collapse(3) gang vector default(present)
17112# 3752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17113#elif defined(MFC_OpenMP)
17114# 3752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17115
17116# 3752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17117
17118# 3752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17119
17120# 3752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17121!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17122# 3752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17123#endif
17124 do i = momxb, momxe
17125 do l = isz%beg, isz%end
17126 do k = isy%beg, isy%end
17127 dqr_prim_dy_vf(i)%sf(m + 1, k, l) = dql_prim_dy_vf(i)%sf(m, k, l)
17128 end do
17129 end do
17130 end do
17131
17132# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17133#if defined(MFC_OpenACC)
17134# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17135!$acc end parallel loop
17136# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17137#elif defined(MFC_OpenMP)
17138# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17139
17140# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17141!$omp end target teams loop
17142# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17143#endif
17144
17145 if (p > 0) then
17146
17147# 3763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17148
17149# 3763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17150#if defined(MFC_OpenACC)
17151# 3763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17152!$acc parallel loop collapse(3) gang vector default(present)
17153# 3763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17154#elif defined(MFC_OpenMP)
17155# 3763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17156
17157# 3763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17158
17159# 3763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17160
17161# 3763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17162!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17163# 3763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17164#endif
17165 do i = momxb, momxe
17166 do l = isz%beg, isz%end
17167 do k = isy%beg, isy%end
17168 dqr_prim_dz_vf(i)%sf(m + 1, k, l) = dql_prim_dz_vf(i)%sf(m, k, l)
17169 end do
17170 end do
17171 end do
17172
17173# 3771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17174#if defined(MFC_OpenACC)
17175# 3771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17176!$acc end parallel loop
17177# 3771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17178#elif defined(MFC_OpenMP)
17179# 3771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17180
17181# 3771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17182!$omp end target teams loop
17183# 3771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17184#endif
17185 end if
17186 end if
17187 end if
17188 end if
17189 ! END: Population of Buffers in x-direction
17190
17191 ! Population of Buffers in y-direction
17192 else if (norm_dir == 2) then
17193 if (bc_y%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
17194
17195# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17196
17197# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17198#if defined(MFC_OpenACC)
17199# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17200!$acc parallel loop collapse(3) gang vector default(present)
17201# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17202#elif defined(MFC_OpenMP)
17203# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17204
17205# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17206
17207# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17208
17209# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17210!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17211# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17212#endif
17213 do i = 1, sys_size
17214 do l = is3%beg, is3%end
17215 do k = is2%beg, is2%end
17216 ql_prim_rsy_vf(-1, k, l, i) = qr_prim_rsy_vf(0, k, l, i)
17217 end do
17218 end do
17219 end do
17220
17221# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17222#if defined(MFC_OpenACC)
17223# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17224!$acc end parallel loop
17225# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17226#elif defined(MFC_OpenMP)
17227# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17228
17229# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17230!$omp end target teams loop
17231# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17232#endif
17233
17234 if (viscous .or. dummy) then
17235
17236# 3792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17237
17238# 3792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17239#if defined(MFC_OpenACC)
17240# 3792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17241!$acc parallel loop collapse(3) gang vector default(present)
17242# 3792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17243#elif defined(MFC_OpenMP)
17244# 3792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17245
17246# 3792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17247
17248# 3792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17249
17250# 3792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17251!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17252# 3792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17253#endif
17254 do i = momxb, momxe
17255 do l = isz%beg, isz%end
17256 do j = isx%beg, isx%end
17257 dql_prim_dx_vf(i)%sf(j, -1, l) = dqr_prim_dx_vf(i)%sf(j, 0, l)
17258 end do
17259 end do
17260 end do
17261
17262# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17263#if defined(MFC_OpenACC)
17264# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17265!$acc end parallel loop
17266# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17267#elif defined(MFC_OpenMP)
17268# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17269
17270# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17271!$omp end target teams loop
17272# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17273#endif
17274
17275
17276# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17277
17278# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17279#if defined(MFC_OpenACC)
17280# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17281!$acc parallel loop collapse(3) gang vector default(present)
17282# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17283#elif defined(MFC_OpenMP)
17284# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17285
17286# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17287
17288# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17289
17290# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17291!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17292# 3802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17293#endif
17294 do i = momxb, momxe
17295 do l = isz%beg, isz%end
17296 do j = isx%beg, isx%end
17297 dql_prim_dy_vf(i)%sf(j, -1, l) = dqr_prim_dy_vf(i)%sf(j, 0, l)
17298 end do
17299 end do
17300 end do
17301
17302# 3810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17303#if defined(MFC_OpenACC)
17304# 3810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17305!$acc end parallel loop
17306# 3810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17307#elif defined(MFC_OpenMP)
17308# 3810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17309
17310# 3810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17311!$omp end target teams loop
17312# 3810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17313#endif
17314
17315 if (p > 0) then
17316
17317# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17318
17319# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17320#if defined(MFC_OpenACC)
17321# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17322!$acc parallel loop collapse(3) gang vector default(present)
17323# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17324#elif defined(MFC_OpenMP)
17325# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17326
17327# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17328
17329# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17330
17331# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17332!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17333# 3813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17334#endif
17335 do i = momxb, momxe
17336 do l = isz%beg, isz%end
17337 do j = isx%beg, isx%end
17338 dql_prim_dz_vf(i)%sf(j, -1, l) = dqr_prim_dz_vf(i)%sf(j, 0, l)
17339 end do
17340 end do
17341 end do
17342
17343# 3821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17344#if defined(MFC_OpenACC)
17345# 3821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17346!$acc end parallel loop
17347# 3821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17348#elif defined(MFC_OpenMP)
17349# 3821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17350
17351# 3821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17352!$omp end target teams loop
17353# 3821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17354#endif
17355 end if
17356 end if
17357 end if
17358
17359 if (bc_y%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
17360
17361
17362# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17363
17364# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17365#if defined(MFC_OpenACC)
17366# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17367!$acc parallel loop collapse(3) gang vector default(present)
17368# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17369#elif defined(MFC_OpenMP)
17370# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17371
17372# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17373
17374# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17375
17376# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17377!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17378# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17379#endif
17380 do i = 1, sys_size
17381 do l = is3%beg, is3%end
17382 do k = is2%beg, is2%end
17383 qr_prim_rsy_vf(n + 1, k, l, i) = ql_prim_rsy_vf(n, k, l, i)
17384 end do
17385 end do
17386 end do
17387
17388# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17389#if defined(MFC_OpenACC)
17390# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17391!$acc end parallel loop
17392# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17393#elif defined(MFC_OpenMP)
17394# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17395
17396# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17397!$omp end target teams loop
17398# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17399#endif
17400
17401 if (viscous .or. dummy) then
17402
17403# 3839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17404
17405# 3839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17406#if defined(MFC_OpenACC)
17407# 3839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17408!$acc parallel loop collapse(3) gang vector default(present)
17409# 3839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17410#elif defined(MFC_OpenMP)
17411# 3839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17412
17413# 3839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17414
17415# 3839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17416
17417# 3839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17418!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17419# 3839 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17420#endif
17421 do i = momxb, momxe
17422 do l = isz%beg, isz%end
17423 do j = isx%beg, isx%end
17424 dqr_prim_dx_vf(i)%sf(j, n + 1, l) = dql_prim_dx_vf(i)%sf(j, n, l)
17425 end do
17426 end do
17427 end do
17428
17429# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17430#if defined(MFC_OpenACC)
17431# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17432!$acc end parallel loop
17433# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17434#elif defined(MFC_OpenMP)
17435# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17436
17437# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17438!$omp end target teams loop
17439# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17440#endif
17441
17442
17443# 3849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17444
17445# 3849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17446#if defined(MFC_OpenACC)
17447# 3849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17448!$acc parallel loop collapse(3) gang vector default(present)
17449# 3849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17450#elif defined(MFC_OpenMP)
17451# 3849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17452
17453# 3849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17454
17455# 3849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17456
17457# 3849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17458!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17459# 3849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17460#endif
17461 do i = momxb, momxe
17462 do l = isz%beg, isz%end
17463 do j = isx%beg, isx%end
17464 dqr_prim_dy_vf(i)%sf(j, n + 1, l) = dql_prim_dy_vf(i)%sf(j, n, l)
17465 end do
17466 end do
17467 end do
17468
17469# 3857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17470#if defined(MFC_OpenACC)
17471# 3857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17472!$acc end parallel loop
17473# 3857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17474#elif defined(MFC_OpenMP)
17475# 3857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17476
17477# 3857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17478!$omp end target teams loop
17479# 3857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17480#endif
17481
17482 if (p > 0) then
17483
17484# 3860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17485
17486# 3860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17487#if defined(MFC_OpenACC)
17488# 3860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17489!$acc parallel loop collapse(3) gang vector default(present)
17490# 3860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17491#elif defined(MFC_OpenMP)
17492# 3860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17493
17494# 3860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17495
17496# 3860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17497
17498# 3860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17499!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17500# 3860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17501#endif
17502 do i = momxb, momxe
17503 do l = isz%beg, isz%end
17504 do j = isx%beg, isx%end
17505 dqr_prim_dz_vf(i)%sf(j, n + 1, l) = dql_prim_dz_vf(i)%sf(j, n, l)
17506 end do
17507 end do
17508 end do
17509
17510# 3868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17511#if defined(MFC_OpenACC)
17512# 3868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17513!$acc end parallel loop
17514# 3868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17515#elif defined(MFC_OpenMP)
17516# 3868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17517
17518# 3868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17519!$omp end target teams loop
17520# 3868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17521#endif
17522 end if
17523 end if
17524 end if
17525 ! END: Population of Buffers in y-direction
17526
17527 ! Population of Buffers in z-direction
17528 else
17529 if (bc_z%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
17530
17531# 3877 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17532
17533# 3877 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17534#if defined(MFC_OpenACC)
17535# 3877 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17536!$acc parallel loop collapse(3) gang vector default(present)
17537# 3877 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17538#elif defined(MFC_OpenMP)
17539# 3877 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17540
17541# 3877 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17542
17543# 3877 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17544
17545# 3877 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17546!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17547# 3877 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17548#endif
17549 do i = 1, sys_size
17550 do l = is3%beg, is3%end
17551 do k = is2%beg, is2%end
17552 ql_prim_rsz_vf(-1, k, l, i) = qr_prim_rsz_vf(0, k, l, i)
17553 end do
17554 end do
17555 end do
17556
17557# 3885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17558#if defined(MFC_OpenACC)
17559# 3885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17560!$acc end parallel loop
17561# 3885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17562#elif defined(MFC_OpenMP)
17563# 3885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17564
17565# 3885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17566!$omp end target teams loop
17567# 3885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17568#endif
17569
17570 if (viscous .or. dummy) then
17571
17572# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17573
17574# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17575#if defined(MFC_OpenACC)
17576# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17577!$acc parallel loop collapse(3) gang vector default(present)
17578# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17579#elif defined(MFC_OpenMP)
17580# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17581
17582# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17583
17584# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17585
17586# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17587!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17588# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17589#endif
17590 do i = momxb, momxe
17591 do k = isy%beg, isy%end
17592 do j = isx%beg, isx%end
17593 dql_prim_dx_vf(i)%sf(j, k, -1) = dqr_prim_dx_vf(i)%sf(j, k, 0)
17594 end do
17595 end do
17596 end do
17597
17598# 3896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17599#if defined(MFC_OpenACC)
17600# 3896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17601!$acc end parallel loop
17602# 3896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17603#elif defined(MFC_OpenMP)
17604# 3896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17605
17606# 3896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17607!$omp end target teams loop
17608# 3896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17609#endif
17610
17611# 3897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17612
17613# 3897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17614#if defined(MFC_OpenACC)
17615# 3897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17616!$acc parallel loop collapse(3) gang vector default(present)
17617# 3897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17618#elif defined(MFC_OpenMP)
17619# 3897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17620
17621# 3897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17622
17623# 3897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17624
17625# 3897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17626!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17627# 3897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17628#endif
17629 do i = momxb, momxe
17630 do k = isy%beg, isy%end
17631 do j = isx%beg, isx%end
17632 dql_prim_dy_vf(i)%sf(j, k, -1) = dqr_prim_dy_vf(i)%sf(j, k, 0)
17633 end do
17634 end do
17635 end do
17636
17637# 3905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17638#if defined(MFC_OpenACC)
17639# 3905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17640!$acc end parallel loop
17641# 3905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17642#elif defined(MFC_OpenMP)
17643# 3905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17644
17645# 3905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17646!$omp end target teams loop
17647# 3905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17648#endif
17649
17650# 3906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17651
17652# 3906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17653#if defined(MFC_OpenACC)
17654# 3906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17655!$acc parallel loop collapse(3) gang vector default(present)
17656# 3906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17657#elif defined(MFC_OpenMP)
17658# 3906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17659
17660# 3906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17661
17662# 3906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17663
17664# 3906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17665!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17666# 3906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17667#endif
17668 do i = momxb, momxe
17669 do k = isy%beg, isy%end
17670 do j = isx%beg, isx%end
17671 dql_prim_dz_vf(i)%sf(j, k, -1) = dqr_prim_dz_vf(i)%sf(j, k, 0)
17672 end do
17673 end do
17674 end do
17675
17676# 3914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17677#if defined(MFC_OpenACC)
17678# 3914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17679!$acc end parallel loop
17680# 3914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17681#elif defined(MFC_OpenMP)
17682# 3914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17683
17684# 3914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17685!$omp end target teams loop
17686# 3914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17687#endif
17688 end if
17689 end if
17690
17691 if (bc_z%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
17692
17693
17694# 3920 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17695
17696# 3920 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17697#if defined(MFC_OpenACC)
17698# 3920 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17699!$acc parallel loop collapse(3) gang vector default(present)
17700# 3920 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17701#elif defined(MFC_OpenMP)
17702# 3920 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17703
17704# 3920 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17705
17706# 3920 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17707
17708# 3920 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17709!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17710# 3920 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17711#endif
17712 do i = 1, sys_size
17713 do l = is3%beg, is3%end
17714 do k = is2%beg, is2%end
17715 qr_prim_rsz_vf(p + 1, k, l, i) = ql_prim_rsz_vf(p, k, l, i)
17716 end do
17717 end do
17718 end do
17719
17720# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17721#if defined(MFC_OpenACC)
17722# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17723!$acc end parallel loop
17724# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17725#elif defined(MFC_OpenMP)
17726# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17727
17728# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17729!$omp end target teams loop
17730# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17731#endif
17732
17733 if (viscous .or. dummy) then
17734
17735# 3931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17736
17737# 3931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17738#if defined(MFC_OpenACC)
17739# 3931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17740!$acc parallel loop collapse(3) gang vector default(present)
17741# 3931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17742#elif defined(MFC_OpenMP)
17743# 3931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17744
17745# 3931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17746
17747# 3931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17748
17749# 3931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17750!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17751# 3931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17752#endif
17753 do i = momxb, momxe
17754 do k = isy%beg, isy%end
17755 do j = isx%beg, isx%end
17756 dqr_prim_dx_vf(i)%sf(j, k, p + 1) = dql_prim_dx_vf(i)%sf(j, k, p)
17757 end do
17758 end do
17759 end do
17760
17761# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17762#if defined(MFC_OpenACC)
17763# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17764!$acc end parallel loop
17765# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17766#elif defined(MFC_OpenMP)
17767# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17768
17769# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17770!$omp end target teams loop
17771# 3939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17772#endif
17773
17774
17775# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17776
17777# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17778#if defined(MFC_OpenACC)
17779# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17780!$acc parallel loop collapse(3) gang vector default(present)
17781# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17782#elif defined(MFC_OpenMP)
17783# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17784
17785# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17786
17787# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17788
17789# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17790!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17791# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17792#endif
17793 do i = momxb, momxe
17794 do k = isy%beg, isy%end
17795 do j = isx%beg, isx%end
17796 dqr_prim_dy_vf(i)%sf(j, k, p + 1) = dql_prim_dy_vf(i)%sf(j, k, p)
17797 end do
17798 end do
17799 end do
17800
17801# 3949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17802#if defined(MFC_OpenACC)
17803# 3949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17804!$acc end parallel loop
17805# 3949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17806#elif defined(MFC_OpenMP)
17807# 3949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17808
17809# 3949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17810!$omp end target teams loop
17811# 3949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17812#endif
17813
17814
17815# 3951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17816
17817# 3951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17818#if defined(MFC_OpenACC)
17819# 3951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17820!$acc parallel loop collapse(3) gang vector default(present)
17821# 3951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17822#elif defined(MFC_OpenMP)
17823# 3951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17824
17825# 3951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17826
17827# 3951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17828
17829# 3951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17830!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17831# 3951 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17832#endif
17833 do i = momxb, momxe
17834 do k = isy%beg, isy%end
17835 do j = isx%beg, isx%end
17836 dqr_prim_dz_vf(i)%sf(j, k, p + 1) = dql_prim_dz_vf(i)%sf(j, k, p)
17837 end do
17838 end do
17839 end do
17840
17841# 3959 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17842#if defined(MFC_OpenACC)
17843# 3959 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17844!$acc end parallel loop
17845# 3959 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17846#elif defined(MFC_OpenMP)
17847# 3959 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17848
17849# 3959 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17850!$omp end target teams loop
17851# 3959 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17852#endif
17853 end if
17854 end if
17855 end if
17856 ! END: Population of Buffers in z-direction
17857
17858 end subroutine s_populate_riemann_states_variables_buffers
17859
17860 !> Set up the chosen Riemann solver algorithm for the current direction
17861 subroutine s_initialize_riemann_solver(flux_src_vf, norm_dir)
17862
17863 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
17864 integer, intent(in) :: norm_dir
17865 integer :: i, j, k, l !< Generic loop iterators
17866
17867 ! Reshaping Inputted Data in x-direction
17868
17869 if (norm_dir == 1) then
17870 if (viscous .or. (surface_tension) .or. dummy) then
17871
17872# 3978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17873
17874# 3978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17875#if defined(MFC_OpenACC)
17876# 3978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17877!$acc parallel loop collapse(4) gang vector default(present)
17878# 3978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17879#elif defined(MFC_OpenMP)
17880# 3978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17881
17882# 3978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17883
17884# 3978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17885
17886# 3978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17887!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17888# 3978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17889#endif
17890 do i = momxb, e_idx
17891 do l = is3%beg, is3%end
17892 do k = is2%beg, is2%end
17893 do j = is1%beg, is1%end
17894 flux_src_vf(i)%sf(j, k, l) = 0._wp
17895 end do
17896 end do
17897 end do
17898 end do
17899
17900# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17901#if defined(MFC_OpenACC)
17902# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17903!$acc end parallel loop
17904# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17905#elif defined(MFC_OpenMP)
17906# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17907
17908# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17909!$omp end target teams loop
17910# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17911#endif
17912 end if
17913
17914 if (chem_params%diffusion) then
17915
17916# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17917
17918# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17919#if defined(MFC_OpenACC)
17920# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17921!$acc parallel loop collapse(4) gang vector default(present)
17922# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17923#elif defined(MFC_OpenMP)
17924# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17925
17926# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17927
17928# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17929
17930# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17931!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17932# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17933#endif
17934 do i = e_idx, chemxe
17935 do l = is3%beg, is3%end
17936 do k = is2%beg, is2%end
17937 do j = is1%beg, is1%end
17938 if (i == e_idx .or. i >= chemxb) then
17939 flux_src_vf(i)%sf(j, k, l) = 0._wp
17940 end if
17941 end do
17942 end do
17943 end do
17944 end do
17945
17946# 4004 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17947#if defined(MFC_OpenACC)
17948# 4004 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17949!$acc end parallel loop
17950# 4004 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17951#elif defined(MFC_OpenMP)
17952# 4004 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17953
17954# 4004 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17955!$omp end target teams loop
17956# 4004 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17957#endif
17958 end if
17959
17960 if (qbmm) then
17961
17962# 4008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17963
17964# 4008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17965#if defined(MFC_OpenACC)
17966# 4008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17967!$acc parallel loop collapse(4) gang vector default(present)
17968# 4008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17969#elif defined(MFC_OpenMP)
17970# 4008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17971
17972# 4008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17973
17974# 4008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17975
17976# 4008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17977!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17978# 4008 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17979#endif
17980 do i = 1, 4
17981 do l = is3%beg, is3%end
17982 do k = is2%beg, is2%end
17983 do j = is1%beg, is1%end + 1
17984 mom_sp_rsx_vf(j, k, l, i) = mom_sp(i)%sf(j, k, l)
17985 end do
17986 end do
17987 end do
17988 end do
17989
17990# 4018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17991#if defined(MFC_OpenACC)
17992# 4018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17993!$acc end parallel loop
17994# 4018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17995#elif defined(MFC_OpenMP)
17996# 4018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17997
17998# 4018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17999!$omp end target teams loop
18000# 4018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18001#endif
18002 end if
18003
18004 ! Reshaping Inputted Data in y-direction
18005 else if (norm_dir == 2) then
18006 if (viscous .or. (surface_tension) .or. dummy) then
18007
18008# 4024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18009
18010# 4024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18011#if defined(MFC_OpenACC)
18012# 4024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18013!$acc parallel loop collapse(4) gang vector default(present)
18014# 4024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18015#elif defined(MFC_OpenMP)
18016# 4024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18017
18018# 4024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18019
18020# 4024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18021
18022# 4024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18023!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18024# 4024 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18025#endif
18026 do i = momxb, e_idx
18027 do l = is3%beg, is3%end
18028 do j = is1%beg, is1%end
18029 do k = is2%beg, is2%end
18030 flux_src_vf(i)%sf(k, j, l) = 0._wp
18031 end do
18032 end do
18033 end do
18034 end do
18035
18036# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18037#if defined(MFC_OpenACC)
18038# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18039!$acc end parallel loop
18040# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18041#elif defined(MFC_OpenMP)
18042# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18043
18044# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18045!$omp end target teams loop
18046# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18047#endif
18048 end if
18049
18050 if (chem_params%diffusion) then
18051
18052# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18053
18054# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18055#if defined(MFC_OpenACC)
18056# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18057!$acc parallel loop collapse(4) gang vector default(present)
18058# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18059#elif defined(MFC_OpenMP)
18060# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18061
18062# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18063
18064# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18065
18066# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18067!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18068# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18069#endif
18070 do i = e_idx, chemxe
18071 do l = is3%beg, is3%end
18072 do j = is1%beg, is1%end
18073 do k = is2%beg, is2%end
18074 if (i == e_idx .or. i >= chemxb) then
18075 flux_src_vf(i)%sf(k, j, l) = 0._wp
18076 end if
18077 end do
18078 end do
18079 end do
18080 end do
18081
18082# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18083#if defined(MFC_OpenACC)
18084# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18085!$acc end parallel loop
18086# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18087#elif defined(MFC_OpenMP)
18088# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18089
18090# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18091!$omp end target teams loop
18092# 4050 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18093#endif
18094 end if
18095
18096 if (qbmm) then
18097
18098# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18099
18100# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18101#if defined(MFC_OpenACC)
18102# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18103!$acc parallel loop collapse(4) gang vector default(present)
18104# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18105#elif defined(MFC_OpenMP)
18106# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18107
18108# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18109
18110# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18111
18112# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18113!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18114# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18115#endif
18116 do i = 1, 4
18117 do l = is3%beg, is3%end
18118 do k = is2%beg, is2%end
18119 do j = is1%beg, is1%end + 1
18120 mom_sp_rsy_vf(j, k, l, i) = mom_sp(i)%sf(k, j, l)
18121 end do
18122 end do
18123 end do
18124 end do
18125
18126# 4064 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18127#if defined(MFC_OpenACC)
18128# 4064 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18129!$acc end parallel loop
18130# 4064 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18131#elif defined(MFC_OpenMP)
18132# 4064 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18133
18134# 4064 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18135!$omp end target teams loop
18136# 4064 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18137#endif
18138 end if
18139
18140 ! Reshaping Inputted Data in z-direction
18141 else
18142 if (viscous .or. (surface_tension) .or. dummy) then
18143
18144# 4070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18145
18146# 4070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18147#if defined(MFC_OpenACC)
18148# 4070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18149!$acc parallel loop collapse(4) gang vector default(present)
18150# 4070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18151#elif defined(MFC_OpenMP)
18152# 4070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18153
18154# 4070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18155
18156# 4070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18157
18158# 4070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18159!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18160# 4070 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18161#endif
18162 do i = momxb, e_idx
18163 do j = is1%beg, is1%end
18164 do k = is2%beg, is2%end
18165 do l = is3%beg, is3%end
18166 flux_src_vf(i)%sf(l, k, j) = 0._wp
18167 end do
18168 end do
18169 end do
18170 end do
18171
18172# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18173#if defined(MFC_OpenACC)
18174# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18175!$acc end parallel loop
18176# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18177#elif defined(MFC_OpenMP)
18178# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18179
18180# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18181!$omp end target teams loop
18182# 4080 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18183#endif
18184 end if
18185
18186 if (chem_params%diffusion) then
18187
18188# 4084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18189
18190# 4084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18191#if defined(MFC_OpenACC)
18192# 4084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18193!$acc parallel loop collapse(4) gang vector default(present)
18194# 4084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18195#elif defined(MFC_OpenMP)
18196# 4084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18197
18198# 4084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18199
18200# 4084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18201
18202# 4084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18203!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18204# 4084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18205#endif
18206 do i = e_idx, chemxe
18207 do j = is1%beg, is1%end
18208 do k = is2%beg, is2%end
18209 do l = is3%beg, is3%end
18210 if (i == e_idx .or. i >= chemxb) then
18211 flux_src_vf(i)%sf(l, k, j) = 0._wp
18212 end if
18213 end do
18214 end do
18215 end do
18216 end do
18217
18218# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18219#if defined(MFC_OpenACC)
18220# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18221!$acc end parallel loop
18222# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18223#elif defined(MFC_OpenMP)
18224# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18225
18226# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18227!$omp end target teams loop
18228# 4096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18229#endif
18230 end if
18231
18232 if (qbmm) then
18233
18234# 4100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18235
18236# 4100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18237#if defined(MFC_OpenACC)
18238# 4100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18239!$acc parallel loop collapse(4) gang vector default(present)
18240# 4100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18241#elif defined(MFC_OpenMP)
18242# 4100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18243
18244# 4100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18245
18246# 4100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18247
18248# 4100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18249!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18250# 4100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18251#endif
18252 do i = 1, 4
18253 do l = is3%beg, is3%end
18254 do k = is2%beg, is2%end
18255 do j = is1%beg, is1%end + 1
18256 mom_sp_rsz_vf(j, k, l, i) = mom_sp(i)%sf(l, k, j)
18257 end do
18258 end do
18259 end do
18260 end do
18261
18262# 4110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18263#if defined(MFC_OpenACC)
18264# 4110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18265!$acc end parallel loop
18266# 4110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18267#elif defined(MFC_OpenMP)
18268# 4110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18269
18270# 4110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18271!$omp end target teams loop
18272# 4110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18273#endif
18274 end if
18275 end if
18276
18277 end subroutine s_initialize_riemann_solver
18278
18279 !> Compute cylindrical viscous source flux contributions for momentum and energy
18280 subroutine s_compute_cylindrical_viscous_source_flux(velL_vf, dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, velR_vf, dvelR_dx_vf, &
18281
18282 & dvelR_dy_vf, dvelR_dz_vf, flux_src_vf, norm_dir, ix, iy, iz)
18283
18284 type(scalar_field), dimension(num_dims), intent(in) :: velL_vf, velR_vf
18285 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
18286 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
18287 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
18288 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
18289 integer, intent(in) :: norm_dir
18290 type(int_bounds_info), intent(in) :: ix, iy, iz
18291
18292 ! Local variables
18293
18294# 4141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18295 real(wp), dimension(num_dims) :: avg_v_int !< Averaged interface velocity (\f$v_x, v_y, v_z\f$) (grid directions).
18296 real(wp), dimension(num_dims) :: avg_dvdx_int !< Averaged interface \f$\partial v_i/\partial x\f$ (grid dir 1).
18297 real(wp), dimension(num_dims) :: avg_dvdy_int !< Averaged interface \f$\partial v_i/\partial y\f$ (grid dir 2).
18298 real(wp), dimension(num_dims) :: avg_dvdz_int !< Averaged interface \f$\partial v_i/\partial z\f$ (grid dir 3).
18299 !> Interface velocity (\f$v_1,v_2,v_3\f$) (grid directions) for viscous work.
18300 real(wp), dimension(num_dims) :: vel_src_int
18301 !> Shear stress vector (\f$\sigma_{N1}, \sigma_{N2}, \sigma_{N3}\f$) on N-face (grid directions).
18302 real(wp), dimension(num_dims) :: stress_vector_shear
18303# 4150 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18304 real(wp) :: stress_normal_bulk !< Normal bulk stress component \f$\sigma_{NN}\f$ on N-face.
18305 real(wp) :: Re_s, Re_b !< Effective interface shear and bulk Reynolds numbers.
18306 real(wp) :: r_eff !< Effective radius at interface for cylindrical terms.
18307 real(wp) :: div_v_term_const !< Common term \f$-(2/3)(\nabla \cdot \mathbf{v}) / \text{Re}_s\f$ for shear stress diagonal.
18308 real(wp) :: divergence_cyl !< Full divergence \f$\nabla \cdot \mathbf{v}\f$ in cylindrical coordinates.
18309 integer :: j, k, l !< Loop iterators for \f$x, y, z\f$ grid directions.
18310 integer :: i_vel !< Loop iterator for velocity components.
18311 integer :: idx_rp(3) !< Indices \f$(j,k,l)\f$ of 'right' point for averaging.
18312
18313
18314# 4159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18315
18316# 4159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18317#if defined(MFC_OpenACC)
18318# 4159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18319!$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)
18320# 4159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18321#elif defined(MFC_OpenMP)
18322# 4159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18323
18324# 4159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18325
18326# 4159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18327
18328# 4159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18329!$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)
18330# 4159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18331#endif
18332# 4161 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18333 do l = iz%beg, iz%end
18334 do k = iy%beg, iy%end
18335 do j = ix%beg, ix%end
18336 ! Determine indices for the 'right' state for averaging across the interface
18337 idx_rp = [j, k, l]
18338 idx_rp(norm_dir) = idx_rp(norm_dir) + 1
18339
18340 ! Average velocities and their derivatives at the interface For cylindrical: x-dir ~ axial (z_cyl), y-dir ~
18341 ! radial (r_cyl), z-dir ~ azimuthal (theta_cyl)
18342
18343# 4170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18344#if defined(MFC_OpenACC)
18345# 4170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18346!$acc loop seq
18347# 4170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18348#elif defined(MFC_OpenMP)
18349# 4170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18350
18351# 4170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18352#endif
18353 do i_vel = 1, num_dims
18354 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)))
18355
18356 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), &
18357 & idx_rp(2), idx_rp(3)))
18358 if (num_dims > 1) then
18359 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), &
18360 & idx_rp(2), idx_rp(3)))
18361 else
18362 avg_dvdy_int(i_vel) = 0.0_wp
18363 end if
18364 if (num_dims > 2) then
18365 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), &
18366 & idx_rp(2), idx_rp(3)))
18367 else
18368 avg_dvdz_int(i_vel) = 0.0_wp
18369 end if
18370 end do
18371
18372 ! Get Re numbers and interface velocity for viscous work
18373 select case (norm_dir)
18374 case (1) ! x-face (axial face in z_cyl direction)
18375 re_s = re_avg_rsx_vf(j, k, l, 1)
18376 re_b = re_avg_rsx_vf(j, k, l, 2)
18377 vel_src_int = vel_src_rsx_vf(j, k, l,1:num_dims)
18378 r_eff = y_cc(k)
18379 case (2) ! y-face (radial face in r_cyl direction)
18380 re_s = re_avg_rsy_vf(k, j, l, 1)
18381 re_b = re_avg_rsy_vf(k, j, l, 2)
18382 vel_src_int = vel_src_rsy_vf(k, j, l,1:num_dims)
18383 r_eff = y_cb(k)
18384 case (3) ! z-face (azimuthal face in theta_cyl direction)
18385 re_s = re_avg_rsz_vf(l, k, j, 1)
18386 re_b = re_avg_rsz_vf(l, k, j, 2)
18387 vel_src_int = vel_src_rsz_vf(l, k, j,1:num_dims)
18388 r_eff = y_cc(k)
18389 end select
18390
18391 ! Divergence in cylindrical coordinates (vx=vz_cyl, vy=vr_cyl, vz=vtheta_cyl)
18392# 4211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18393 divergence_cyl = avg_dvdx_int(1) + avg_dvdy_int(2) + avg_v_int(2)/r_eff
18394 if (num_dims > 2) then
18395# 4214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18396 divergence_cyl = divergence_cyl + avg_dvdz_int(3)/r_eff
18397# 4216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18398 end if
18399# 4218 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18400
18401 stress_vector_shear = 0.0_wp
18402 stress_normal_bulk = 0.0_wp
18403
18404 if (shear_stress) then
18405 div_v_term_const = -(2.0_wp/3.0_wp)*divergence_cyl/re_s
18406
18407 select case (norm_dir)
18408 case (1) ! X-face (axial normal, z_cyl)
18409 stress_vector_shear(1) = (2.0_wp*avg_dvdx_int(1))/re_s + div_v_term_const
18410 if (num_dims > 1) then
18411# 4230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18412 stress_vector_shear(2) = (avg_dvdy_int(1) + avg_dvdx_int(2))/re_s
18413# 4232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18414 end if
18415 if (num_dims > 2) then
18416# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18417 stress_vector_shear(3) = (avg_dvdz_int(1)/r_eff + avg_dvdx_int(3))/re_s
18418# 4237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18419 end if
18420 case (2) ! Y-face (radial normal, r_cyl)
18421 if (num_dims > 1) then
18422# 4241 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18423 stress_vector_shear(1) = (avg_dvdy_int(1) + avg_dvdx_int(2))/re_s
18424 stress_vector_shear(2) = (2.0_wp*avg_dvdy_int(2))/re_s + div_v_term_const
18425 if (num_dims > 2) then
18426# 4245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18427 stress_vector_shear(3) = (avg_dvdz_int(2)/r_eff - avg_v_int(3)/r_eff + avg_dvdy_int(3) &
18428 & )/re_s
18429# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18430 end if
18431# 4250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18432 else
18433 stress_vector_shear(1) = (2.0_wp*avg_dvdx_int(1))/re_s + div_v_term_const
18434 end if
18435 case (3) ! Z-face (azimuthal normal, theta_cyl)
18436 if (num_dims > 2) then
18437# 4256 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18438 stress_vector_shear(1) = (avg_dvdz_int(1)/r_eff + avg_dvdx_int(3))/re_s
18439 stress_vector_shear(2) = (avg_dvdz_int(2)/r_eff - avg_v_int(3)/r_eff + avg_dvdy_int(3))/re_s
18440 stress_vector_shear(3) = (2.0_wp*(avg_dvdz_int(3)/r_eff + avg_v_int(2)/r_eff))/re_s &
18441 & + div_v_term_const
18442# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18443 end if
18444 end select
18445
18446
18447# 4264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18448#if defined(MFC_OpenACC)
18449# 4264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18450!$acc loop seq
18451# 4264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18452#elif defined(MFC_OpenMP)
18453# 4264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18454
18455# 4264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18456#endif
18457 do i_vel = 1, num_dims
18458 flux_src_vf(momxb + i_vel - 1)%sf(j, k, l) = flux_src_vf(momxb + i_vel - 1)%sf(j, k, &
18459 & l) - stress_vector_shear(i_vel)
18460 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, &
18461 & l) - vel_src_int(i_vel)*stress_vector_shear(i_vel)
18462 end do
18463 end if
18464
18465 if (bulk_stress) then
18466 stress_normal_bulk = divergence_cyl/re_b
18467
18468 flux_src_vf(momxb + norm_dir - 1)%sf(j, k, l) = flux_src_vf(momxb + norm_dir - 1)%sf(j, k, &
18469 & l) - stress_normal_bulk
18470 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - vel_src_int(norm_dir)*stress_normal_bulk
18471 end if
18472 end do
18473 end do
18474 end do
18475
18476# 4283 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18477#if defined(MFC_OpenACC)
18478# 4283 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18479!$acc end parallel loop
18480# 4283 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18481#elif defined(MFC_OpenMP)
18482# 4283 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18483
18484# 4283 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18485!$omp end target teams loop
18486# 4283 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18487#endif
18488
18489 end subroutine s_compute_cylindrical_viscous_source_flux
18490
18491 !> Compute Cartesian viscous source flux contributions for momentum and energy
18492 subroutine s_compute_cartesian_viscous_source_flux(dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, dvelR_dx_vf, dvelR_dy_vf, &
18493
18494 & dvelR_dz_vf, flux_src_vf, norm_dir)
18495
18496 ! Arguments
18497 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
18498 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
18499 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
18500 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
18501 integer, intent(in) :: norm_dir
18502
18503 ! Local variables
18504
18505# 4307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18506 real(wp), dimension(num_dims, num_dims) :: vel_grad_avg !< Averaged velocity gradient tensor `d(vel_i)/d(coord_j)`.
18507 real(wp), dimension(num_dims, num_dims) :: current_tau_shear !< Current shear stress tensor.
18508 real(wp), dimension(num_dims, num_dims) :: current_tau_bulk !< Current bulk stress tensor.
18509 real(wp), dimension(num_dims) :: vel_src_at_interface !< Interface velocities (u,v,w) for viscous work.
18510# 4312 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18511 integer, dimension(3) :: idx_right_phys !< Physical (j,k,l) indices for right state.
18512 real(wp) :: Re_shear !< Interface shear Reynolds number.
18513 real(wp) :: Re_bulk !< Interface bulk Reynolds number.
18514 integer :: j_loop !< Physical x-index loop iterator.
18515 integer :: k_loop !< Physical y-index loop iterator.
18516 integer :: l_loop !< Physical z-index loop iterator.
18517 integer :: i_dim !< Generic dimension/component iterator.
18518 integer :: vel_comp_idx !< Velocity component iterator (1=u, 2=v, 3=w).
18519 real(wp) :: divergence_v !< Velocity divergence at interface.
18520
18521
18522# 4322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18523
18524# 4322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18525#if defined(MFC_OpenACC)
18526# 4322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18527!$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)
18528# 4322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18529#elif defined(MFC_OpenMP)
18530# 4322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18531
18532# 4322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18533
18534# 4322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18535
18536# 4322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18537!$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)
18538# 4322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18539#endif
18540# 4324 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18541 do l_loop = isz%beg, isz%end
18542 do k_loop = isy%beg, isy%end
18543 do j_loop = isx%beg, isx%end
18544 idx_right_phys(1) = j_loop
18545 idx_right_phys(2) = k_loop
18546 idx_right_phys(3) = l_loop
18547 idx_right_phys(norm_dir) = idx_right_phys(norm_dir) + 1
18548
18549 vel_grad_avg = 0.0_wp
18550 do vel_comp_idx = 1, num_dims
18551 vel_grad_avg(vel_comp_idx, 1) = 0.5_wp*(dvell_dx_vf(vel_comp_idx)%sf(j_loop, k_loop, &
18552 & l_loop) + dvelr_dx_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), &
18553 & idx_right_phys(3)))
18554 if (num_dims > 1) then
18555# 4339 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18556 vel_grad_avg(vel_comp_idx, 2) = 0.5_wp*(dvell_dy_vf(vel_comp_idx)%sf(j_loop, k_loop, &
18557 & l_loop) + dvelr_dy_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), &
18558 & idx_right_phys(3)))
18559# 4343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18560 end if
18561 if (num_dims > 2) then
18562# 4346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18563 vel_grad_avg(vel_comp_idx, 3) = 0.5_wp*(dvell_dz_vf(vel_comp_idx)%sf(j_loop, k_loop, &
18564 & l_loop) + dvelr_dz_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), &
18565 & idx_right_phys(3)))
18566# 4350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18567 end if
18568 end do
18569
18570 divergence_v = 0.0_wp
18571 do i_dim = 1, num_dims
18572 divergence_v = divergence_v + vel_grad_avg(i_dim, i_dim)
18573 end do
18574
18575 vel_src_at_interface = 0.0_wp
18576 if (norm_dir == 1) then
18577 re_shear = re_avg_rsx_vf(j_loop, k_loop, l_loop, 1)
18578 re_bulk = re_avg_rsx_vf(j_loop, k_loop, l_loop, 2)
18579 do i_dim = 1, num_dims
18580 vel_src_at_interface(i_dim) = vel_src_rsx_vf(j_loop, k_loop, l_loop, i_dim)
18581 end do
18582 else if (norm_dir == 2) then
18583 re_shear = re_avg_rsy_vf(k_loop, j_loop, l_loop, 1)
18584 re_bulk = re_avg_rsy_vf(k_loop, j_loop, l_loop, 2)
18585 do i_dim = 1, num_dims
18586 vel_src_at_interface(i_dim) = vel_src_rsy_vf(k_loop, j_loop, l_loop, i_dim)
18587 end do
18588 else
18589 re_shear = re_avg_rsz_vf(l_loop, k_loop, j_loop, 1)
18590 re_bulk = re_avg_rsz_vf(l_loop, k_loop, j_loop, 2)
18591 do i_dim = 1, num_dims
18592 vel_src_at_interface(i_dim) = vel_src_rsz_vf(l_loop, k_loop, j_loop, i_dim)
18593 end do
18594 end if
18595
18596 if (shear_stress) then
18597 ! current_tau_shear = 0.0_wp
18598 call s_calculate_shear_stress_tensor(vel_grad_avg, re_shear, divergence_v, current_tau_shear)
18599
18600 do i_dim = 1, num_dims
18601 flux_src_vf(momxb + i_dim - 1)%sf(j_loop, k_loop, l_loop) = flux_src_vf(momxb + i_dim - 1)%sf(j_loop, &
18602 & k_loop, l_loop) - current_tau_shear(norm_dir, i_dim)
18603
18604 flux_src_vf(e_idx)%sf(j_loop, k_loop, l_loop) = flux_src_vf(e_idx)%sf(j_loop, k_loop, &
18605 & l_loop) - vel_src_at_interface(i_dim)*current_tau_shear(norm_dir, i_dim)
18606 end do
18607 end if
18608
18609 if (bulk_stress) then
18610 ! current_tau_bulk = 0.0_wp
18611 call s_calculate_bulk_stress_tensor(re_bulk, divergence_v, current_tau_bulk)
18612
18613 do i_dim = 1, num_dims
18614 flux_src_vf(momxb + i_dim - 1)%sf(j_loop, k_loop, l_loop) = flux_src_vf(momxb + i_dim - 1)%sf(j_loop, &
18615 & k_loop, l_loop) - current_tau_bulk(norm_dir, i_dim)
18616
18617 flux_src_vf(e_idx)%sf(j_loop, k_loop, l_loop) = flux_src_vf(e_idx)%sf(j_loop, k_loop, &
18618 & l_loop) - vel_src_at_interface(i_dim)*current_tau_bulk(norm_dir, i_dim)
18619 end do
18620 end if
18621 end do
18622 end do
18623 end do
18624
18625# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18626#if defined(MFC_OpenACC)
18627# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18628!$acc end parallel loop
18629# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18630#elif defined(MFC_OpenMP)
18631# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18632
18633# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18634!$omp end target teams loop
18635# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18636#endif
18637
18638 end subroutine s_compute_cartesian_viscous_source_flux
18639
18640 !> Compute shear stress tensor components
18641 subroutine s_calculate_shear_stress_tensor(vel_grad_avg, Re_shear, divergence_v, tau_shear_out)
18642
18643
18644# 4414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18645#if MFC_OpenACC
18646# 4414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18647!$acc routine seq
18648# 4414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18649#elif MFC_OpenMP
18650# 4414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18651
18652# 4414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18653
18654# 4414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18655!$omp declare target device_type(any)
18656# 4414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18657#endif
18658
18659 ! Arguments
18660# 4421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18661 real(wp), dimension(num_dims, num_dims), intent(in) :: vel_grad_avg
18662 real(wp), dimension(num_dims, num_dims), intent(out) :: tau_shear_out
18663# 4424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18664 real(wp), intent(in) :: Re_shear
18665 real(wp), intent(in) :: divergence_v
18666
18667 ! Local variables
18668 integer :: i_dim !< Loop iterator for face normal.
18669 integer :: j_dim !< Loop iterator for force component direction.
18670 tau_shear_out = 0.0_wp
18671
18672 do i_dim = 1, num_dims
18673 do j_dim = 1, num_dims
18674 tau_shear_out(i_dim, j_dim) = (vel_grad_avg(j_dim, i_dim) + vel_grad_avg(i_dim, j_dim))/re_shear
18675 if (i_dim == j_dim) then
18676 tau_shear_out(i_dim, j_dim) = tau_shear_out(i_dim, j_dim) - (2.0_wp/3.0_wp)*divergence_v/re_shear
18677 end if
18678 end do
18679 end do
18680
18681 end subroutine s_calculate_shear_stress_tensor
18682
18683 !> Compute bulk stress tensor components (diagonal only)
18684 subroutine s_calculate_bulk_stress_tensor(Re_bulk, divergence_v, tau_bulk_out)
18685
18686
18687# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18688#if MFC_OpenACC
18689# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18690!$acc routine seq
18691# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18692#elif MFC_OpenMP
18693# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18694
18695# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18696
18697# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18698!$omp declare target device_type(any)
18699# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18700#endif
18701
18702 ! Arguments
18703 real(wp), intent(in) :: Re_bulk
18704 real(wp), intent(in) :: divergence_v
18705# 4454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18706 real(wp), dimension(num_dims, num_dims), intent(out) :: tau_bulk_out
18707# 4456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18708
18709 ! Local variables
18710 integer :: i_dim !< Loop iterator for diagonal components.
18711 tau_bulk_out = 0.0_wp
18712
18713 do i_dim = 1, num_dims
18714 tau_bulk_out(i_dim, i_dim) = divergence_v/re_bulk
18715 end do
18716
18717 end subroutine s_calculate_bulk_stress_tensor
18718
18719 !> Deallocation and/or disassociation procedures that are needed to finalize the selected Riemann problem solver
18720 subroutine s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
18721
18722 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
18723 integer, intent(in) :: norm_dir
18724 integer :: i, j, k, l !< Generic loop iterators
18725 ! Reshaping Outputted Data in y-direction
18726
18727 if (norm_dir == 2) then
18728
18729# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18730
18731# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18732#if defined(MFC_OpenACC)
18733# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18734!$acc parallel loop collapse(4) gang vector default(present)
18735# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18736#elif defined(MFC_OpenMP)
18737# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18738
18739# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18740
18741# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18742
18743# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18744!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18745# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18746#endif
18747 do i = 1, sys_size
18748 do l = is3%beg, is3%end
18749 do j = is1%beg, is1%end
18750 do k = is2%beg, is2%end
18751 flux_vf(i)%sf(k, j, l) = flux_rsy_vf(j, k, l, i)
18752 end do
18753 end do
18754 end do
18755 end do
18756
18757# 4486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18758#if defined(MFC_OpenACC)
18759# 4486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18760!$acc end parallel loop
18761# 4486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18762#elif defined(MFC_OpenMP)
18763# 4486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18764
18765# 4486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18766!$omp end target teams loop
18767# 4486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18768#endif
18769
18770 if (cyl_coord) then
18771
18772# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18773
18774# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18775#if defined(MFC_OpenACC)
18776# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18777!$acc parallel loop collapse(4) gang vector default(present)
18778# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18779#elif defined(MFC_OpenMP)
18780# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18781
18782# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18783
18784# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18785
18786# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18787!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18788# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18789#endif
18790 do i = 1, sys_size
18791 do l = is3%beg, is3%end
18792 do j = is1%beg, is1%end
18793 do k = is2%beg, is2%end
18794 flux_gsrc_vf(i)%sf(k, j, l) = flux_gsrc_rsy_vf(j, k, l, i)
18795 end do
18796 end do
18797 end do
18798 end do
18799
18800# 4499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18801#if defined(MFC_OpenACC)
18802# 4499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18803!$acc end parallel loop
18804# 4499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18805#elif defined(MFC_OpenMP)
18806# 4499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18807
18808# 4499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18809!$omp end target teams loop
18810# 4499 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18811#endif
18812 end if
18813
18814
18815# 4502 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18816
18817# 4502 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18818#if defined(MFC_OpenACC)
18819# 4502 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18820!$acc parallel loop collapse(3) gang vector default(present)
18821# 4502 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18822#elif defined(MFC_OpenMP)
18823# 4502 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18824
18825# 4502 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18826
18827# 4502 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18828
18829# 4502 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18830!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18831# 4502 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18832#endif
18833 do l = is3%beg, is3%end
18834 do j = is1%beg, is1%end
18835 do k = is2%beg, is2%end
18836 flux_src_vf(advxb)%sf(k, j, l) = flux_src_rsy_vf(j, k, l, advxb)
18837 end do
18838 end do
18839 end do
18840
18841# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18842#if defined(MFC_OpenACC)
18843# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18844!$acc end parallel loop
18845# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18846#elif defined(MFC_OpenMP)
18847# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18848
18849# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18850!$omp end target teams loop
18851# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18852#endif
18853
18854 if (riemann_solver == 1 .or. riemann_solver == 4) then
18855
18856# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18857
18858# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18859#if defined(MFC_OpenACC)
18860# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18861!$acc parallel loop collapse(4) gang vector default(present)
18862# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18863#elif defined(MFC_OpenMP)
18864# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18865
18866# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18867
18868# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18869
18870# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18871!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18872# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18873#endif
18874 do i = advxb + 1, advxe
18875 do l = is3%beg, is3%end
18876 do j = is1%beg, is1%end
18877 do k = is2%beg, is2%end
18878 flux_src_vf(i)%sf(k, j, l) = flux_src_rsy_vf(j, k, l, i)
18879 end do
18880 end do
18881 end do
18882 end do
18883
18884# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18885#if defined(MFC_OpenACC)
18886# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18887!$acc end parallel loop
18888# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18889#elif defined(MFC_OpenMP)
18890# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18891
18892# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18893!$omp end target teams loop
18894# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18895#endif
18896 end if
18897 ! Reshaping Outputted Data in z-direction
18898 else if (norm_dir == 3) then
18899
18900# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18901
18902# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18903#if defined(MFC_OpenACC)
18904# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18905!$acc parallel loop collapse(4) gang vector default(present)
18906# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18907#elif defined(MFC_OpenMP)
18908# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18909
18910# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18911
18912# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18913
18914# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18915!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18916# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18917#endif
18918 do i = 1, sys_size
18919 do j = is1%beg, is1%end
18920 do k = is2%beg, is2%end
18921 do l = is3%beg, is3%end
18922 flux_vf(i)%sf(l, k, j) = flux_rsz_vf(j, k, l, i)
18923 end do
18924 end do
18925 end do
18926 end do
18927
18928# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18929#if defined(MFC_OpenACC)
18930# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18931!$acc end parallel loop
18932# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18933#elif defined(MFC_OpenMP)
18934# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18935
18936# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18937!$omp end target teams loop
18938# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18939#endif
18940 if (grid_geometry == 3) then
18941
18942# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18943
18944# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18945#if defined(MFC_OpenACC)
18946# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18947!$acc parallel loop collapse(4) gang vector default(present)
18948# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18949#elif defined(MFC_OpenMP)
18950# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18951
18952# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18953
18954# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18955
18956# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18957!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18958# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18959#endif
18960 do i = 1, sys_size
18961 do j = is1%beg, is1%end
18962 do k = is2%beg, is2%end
18963 do l = is3%beg, is3%end
18964 flux_gsrc_vf(i)%sf(l, k, j) = flux_gsrc_rsz_vf(j, k, l, i)
18965 end do
18966 end do
18967 end do
18968 end do
18969
18970# 4549 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18971#if defined(MFC_OpenACC)
18972# 4549 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18973!$acc end parallel loop
18974# 4549 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18975#elif defined(MFC_OpenMP)
18976# 4549 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18977
18978# 4549 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18979!$omp end target teams loop
18980# 4549 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18981#endif
18982 end if
18983
18984
18985# 4552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18986
18987# 4552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18988#if defined(MFC_OpenACC)
18989# 4552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18990!$acc parallel loop collapse(3) gang vector default(present)
18991# 4552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18992#elif defined(MFC_OpenMP)
18993# 4552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18994
18995# 4552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18996
18997# 4552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18998
18999# 4552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19000!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19001# 4552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19002#endif
19003 do j = is1%beg, is1%end
19004 do k = is2%beg, is2%end
19005 do l = is3%beg, is3%end
19006 flux_src_vf(advxb)%sf(l, k, j) = flux_src_rsz_vf(j, k, l, advxb)
19007 end do
19008 end do
19009 end do
19010
19011# 4560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19012#if defined(MFC_OpenACC)
19013# 4560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19014!$acc end parallel loop
19015# 4560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19016#elif defined(MFC_OpenMP)
19017# 4560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19018
19019# 4560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19020!$omp end target teams loop
19021# 4560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19022#endif
19023
19024 if (riemann_solver == 1 .or. riemann_solver == 4) then
19025
19026# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19027
19028# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19029#if defined(MFC_OpenACC)
19030# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19031!$acc parallel loop collapse(4) gang vector default(present)
19032# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19033#elif defined(MFC_OpenMP)
19034# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19035
19036# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19037
19038# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19039
19040# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19041!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19042# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19043#endif
19044 do i = advxb + 1, advxe
19045 do j = is1%beg, is1%end
19046 do k = is2%beg, is2%end
19047 do l = is3%beg, is3%end
19048 flux_src_vf(i)%sf(l, k, j) = flux_src_rsz_vf(j, k, l, i)
19049 end do
19050 end do
19051 end do
19052 end do
19053
19054# 4573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19055#if defined(MFC_OpenACC)
19056# 4573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19057!$acc end parallel loop
19058# 4573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19059#elif defined(MFC_OpenMP)
19060# 4573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19061
19062# 4573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19063!$omp end target teams loop
19064# 4573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19065#endif
19066 end if
19067 else if (norm_dir == 1) then
19068
19069# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19070
19071# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19072#if defined(MFC_OpenACC)
19073# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19074!$acc parallel loop collapse(4) gang vector default(present)
19075# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19076#elif defined(MFC_OpenMP)
19077# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19078
19079# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19080
19081# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19082
19083# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19084!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19085# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19086#endif
19087 do i = 1, sys_size
19088 do l = is3%beg, is3%end
19089 do k = is2%beg, is2%end
19090 do j = is1%beg, is1%end
19091 flux_vf(i)%sf(j, k, l) = flux_rsx_vf(j, k, l, i)
19092 end do
19093 end do
19094 end do
19095 end do
19096
19097# 4586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19098#if defined(MFC_OpenACC)
19099# 4586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19100!$acc end parallel loop
19101# 4586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19102#elif defined(MFC_OpenMP)
19103# 4586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19104
19105# 4586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19106!$omp end target teams loop
19107# 4586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19108#endif
19109
19110
19111# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19112
19113# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19114#if defined(MFC_OpenACC)
19115# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19116!$acc parallel loop collapse(3) gang vector default(present)
19117# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19118#elif defined(MFC_OpenMP)
19119# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19120
19121# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19122
19123# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19124
19125# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19126!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19127# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19128#endif
19129 do l = is3%beg, is3%end
19130 do k = is2%beg, is2%end
19131 do j = is1%beg, is1%end
19132 flux_src_vf(advxb)%sf(j, k, l) = flux_src_rsx_vf(j, k, l, advxb)
19133 end do
19134 end do
19135 end do
19136
19137# 4596 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19138#if defined(MFC_OpenACC)
19139# 4596 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19140!$acc end parallel loop
19141# 4596 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19142#elif defined(MFC_OpenMP)
19143# 4596 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19144
19145# 4596 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19146!$omp end target teams loop
19147# 4596 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19148#endif
19149
19150 if (riemann_solver == 1 .or. riemann_solver == 4) then
19151
19152# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19153
19154# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19155#if defined(MFC_OpenACC)
19156# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19157!$acc parallel loop collapse(4) gang vector default(present)
19158# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19159#elif defined(MFC_OpenMP)
19160# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19161
19162# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19163
19164# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19165
19166# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19167!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19168# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19169#endif
19170 do i = advxb + 1, advxe
19171 do l = is3%beg, is3%end
19172 do k = is2%beg, is2%end
19173 do j = is1%beg, is1%end
19174 flux_src_vf(i)%sf(j, k, l) = flux_src_rsx_vf(j, k, l, i)
19175 end do
19176 end do
19177 end do
19178 end do
19179
19180# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19181#if defined(MFC_OpenACC)
19182# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19183!$acc end parallel loop
19184# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19185#elif defined(MFC_OpenMP)
19186# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19187
19188# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19189!$omp end target teams loop
19190# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19191#endif
19192 end if
19193 end if
19194
19195 end subroutine s_finalize_riemann_solver
19196
19197 !> Module deallocation and/or disassociation procedures
19198 impure subroutine s_finalize_riemann_solvers_module
19199
19200 if (viscous) then
19201#ifdef MFC_DEBUG
19202# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19203 block
19204# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19205 use iso_fortran_env, only: output_unit
19206# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19207
19208# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19209 print *, 'm_riemann_solvers.fpp:4619: ', '@:DEALLOCATE(Re_avg_rsx_vf)'
19210# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19211
19212# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19213 call flush (output_unit)
19214# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19215 end block
19216# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19217#endif
19218# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19219
19220# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19221#if defined(MFC_OpenACC)
19222# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19223!$acc exit data delete(Re_avg_rsx_vf)
19224# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19225#elif defined(MFC_OpenMP)
19226# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19227!$omp target exit data map(release:Re_avg_rsx_vf)
19228# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19229#endif
19230# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19231 deallocate (re_avg_rsx_vf)
19232 end if
19233#ifdef MFC_DEBUG
19234# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19235 block
19236# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19237 use iso_fortran_env, only: output_unit
19238# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19239
19240# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19241 print *, 'm_riemann_solvers.fpp:4621: ', '@:DEALLOCATE(vel_src_rsx_vf)'
19242# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19243
19244# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19245 call flush (output_unit)
19246# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19247 end block
19248# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19249#endif
19250# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19251
19252# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19253#if defined(MFC_OpenACC)
19254# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19255!$acc exit data delete(vel_src_rsx_vf)
19256# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19257#elif defined(MFC_OpenMP)
19258# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19259!$omp target exit data map(release:vel_src_rsx_vf)
19260# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19261#endif
19262# 4621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19263 deallocate (vel_src_rsx_vf)
19264#ifdef MFC_DEBUG
19265# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19266 block
19267# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19268 use iso_fortran_env, only: output_unit
19269# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19270
19271# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19272 print *, 'm_riemann_solvers.fpp:4622: ', '@:DEALLOCATE(flux_rsx_vf)'
19273# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19274
19275# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19276 call flush (output_unit)
19277# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19278 end block
19279# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19280#endif
19281# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19282
19283# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19284#if defined(MFC_OpenACC)
19285# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19286!$acc exit data delete(flux_rsx_vf)
19287# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19288#elif defined(MFC_OpenMP)
19289# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19290!$omp target exit data map(release:flux_rsx_vf)
19291# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19292#endif
19293# 4622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19294 deallocate (flux_rsx_vf)
19295#ifdef MFC_DEBUG
19296# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19297 block
19298# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19299 use iso_fortran_env, only: output_unit
19300# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19301
19302# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19303 print *, 'm_riemann_solvers.fpp:4623: ', '@:DEALLOCATE(flux_src_rsx_vf)'
19304# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19305
19306# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19307 call flush (output_unit)
19308# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19309 end block
19310# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19311#endif
19312# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19313
19314# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19315#if defined(MFC_OpenACC)
19316# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19317!$acc exit data delete(flux_src_rsx_vf)
19318# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19319#elif defined(MFC_OpenMP)
19320# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19321!$omp target exit data map(release:flux_src_rsx_vf)
19322# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19323#endif
19324# 4623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19325 deallocate (flux_src_rsx_vf)
19326#ifdef MFC_DEBUG
19327# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19328 block
19329# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19330 use iso_fortran_env, only: output_unit
19331# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19332
19333# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19334 print *, 'm_riemann_solvers.fpp:4624: ', '@:DEALLOCATE(flux_gsrc_rsx_vf)'
19335# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19336
19337# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19338 call flush (output_unit)
19339# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19340 end block
19341# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19342#endif
19343# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19344
19345# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19346#if defined(MFC_OpenACC)
19347# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19348!$acc exit data delete(flux_gsrc_rsx_vf)
19349# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19350#elif defined(MFC_OpenMP)
19351# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19352!$omp target exit data map(release:flux_gsrc_rsx_vf)
19353# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19354#endif
19355# 4624 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19356 deallocate (flux_gsrc_rsx_vf)
19357 if (qbmm) then
19358#ifdef MFC_DEBUG
19359# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19360 block
19361# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19362 use iso_fortran_env, only: output_unit
19363# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19364
19365# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19366 print *, 'm_riemann_solvers.fpp:4626: ', '@:DEALLOCATE(mom_sp_rsx_vf)'
19367# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19368
19369# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19370 call flush (output_unit)
19371# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19372 end block
19373# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19374#endif
19375# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19376
19377# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19378#if defined(MFC_OpenACC)
19379# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19380!$acc exit data delete(mom_sp_rsx_vf)
19381# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19382#elif defined(MFC_OpenMP)
19383# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19384!$omp target exit data map(release:mom_sp_rsx_vf)
19385# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19386#endif
19387# 4626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19388 deallocate (mom_sp_rsx_vf)
19389 end if
19390
19391 if (n == 0) return
19392
19393 if (viscous) then
19394#ifdef MFC_DEBUG
19395# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19396 block
19397# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19398 use iso_fortran_env, only: output_unit
19399# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19400
19401# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19402 print *, 'm_riemann_solvers.fpp:4632: ', '@:DEALLOCATE(Re_avg_rsy_vf)'
19403# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19404
19405# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19406 call flush (output_unit)
19407# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19408 end block
19409# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19410#endif
19411# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19412
19413# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19414#if defined(MFC_OpenACC)
19415# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19416!$acc exit data delete(Re_avg_rsy_vf)
19417# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19418#elif defined(MFC_OpenMP)
19419# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19420!$omp target exit data map(release:Re_avg_rsy_vf)
19421# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19422#endif
19423# 4632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19424 deallocate (re_avg_rsy_vf)
19425 end if
19426#ifdef MFC_DEBUG
19427# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19428 block
19429# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19430 use iso_fortran_env, only: output_unit
19431# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19432
19433# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19434 print *, 'm_riemann_solvers.fpp:4634: ', '@:DEALLOCATE(vel_src_rsy_vf)'
19435# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19436
19437# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19438 call flush (output_unit)
19439# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19440 end block
19441# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19442#endif
19443# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19444
19445# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19446#if defined(MFC_OpenACC)
19447# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19448!$acc exit data delete(vel_src_rsy_vf)
19449# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19450#elif defined(MFC_OpenMP)
19451# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19452!$omp target exit data map(release:vel_src_rsy_vf)
19453# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19454#endif
19455# 4634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19456 deallocate (vel_src_rsy_vf)
19457#ifdef MFC_DEBUG
19458# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19459 block
19460# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19461 use iso_fortran_env, only: output_unit
19462# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19463
19464# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19465 print *, 'm_riemann_solvers.fpp:4635: ', '@:DEALLOCATE(flux_rsy_vf)'
19466# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19467
19468# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19469 call flush (output_unit)
19470# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19471 end block
19472# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19473#endif
19474# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19475
19476# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19477#if defined(MFC_OpenACC)
19478# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19479!$acc exit data delete(flux_rsy_vf)
19480# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19481#elif defined(MFC_OpenMP)
19482# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19483!$omp target exit data map(release:flux_rsy_vf)
19484# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19485#endif
19486# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19487 deallocate (flux_rsy_vf)
19488#ifdef MFC_DEBUG
19489# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19490 block
19491# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19492 use iso_fortran_env, only: output_unit
19493# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19494
19495# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19496 print *, 'm_riemann_solvers.fpp:4636: ', '@:DEALLOCATE(flux_src_rsy_vf)'
19497# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19498
19499# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19500 call flush (output_unit)
19501# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19502 end block
19503# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19504#endif
19505# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19506
19507# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19508#if defined(MFC_OpenACC)
19509# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19510!$acc exit data delete(flux_src_rsy_vf)
19511# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19512#elif defined(MFC_OpenMP)
19513# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19514!$omp target exit data map(release:flux_src_rsy_vf)
19515# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19516#endif
19517# 4636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19518 deallocate (flux_src_rsy_vf)
19519#ifdef MFC_DEBUG
19520# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19521 block
19522# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19523 use iso_fortran_env, only: output_unit
19524# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19525
19526# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19527 print *, 'm_riemann_solvers.fpp:4637: ', '@:DEALLOCATE(flux_gsrc_rsy_vf)'
19528# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19529
19530# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19531 call flush (output_unit)
19532# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19533 end block
19534# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19535#endif
19536# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19537
19538# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19539#if defined(MFC_OpenACC)
19540# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19541!$acc exit data delete(flux_gsrc_rsy_vf)
19542# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19543#elif defined(MFC_OpenMP)
19544# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19545!$omp target exit data map(release:flux_gsrc_rsy_vf)
19546# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19547#endif
19548# 4637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19549 deallocate (flux_gsrc_rsy_vf)
19550 if (qbmm) then
19551#ifdef MFC_DEBUG
19552# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19553 block
19554# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19555 use iso_fortran_env, only: output_unit
19556# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19557
19558# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19559 print *, 'm_riemann_solvers.fpp:4639: ', '@:DEALLOCATE(mom_sp_rsy_vf)'
19560# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19561
19562# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19563 call flush (output_unit)
19564# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19565 end block
19566# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19567#endif
19568# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19569
19570# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19571#if defined(MFC_OpenACC)
19572# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19573!$acc exit data delete(mom_sp_rsy_vf)
19574# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19575#elif defined(MFC_OpenMP)
19576# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19577!$omp target exit data map(release:mom_sp_rsy_vf)
19578# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19579#endif
19580# 4639 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19581 deallocate (mom_sp_rsy_vf)
19582 end if
19583
19584 if (p == 0) return
19585
19586 if (viscous) then
19587#ifdef MFC_DEBUG
19588# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19589 block
19590# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19591 use iso_fortran_env, only: output_unit
19592# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19593
19594# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19595 print *, 'm_riemann_solvers.fpp:4645: ', '@:DEALLOCATE(Re_avg_rsz_vf)'
19596# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19597
19598# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19599 call flush (output_unit)
19600# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19601 end block
19602# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19603#endif
19604# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19605
19606# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19607#if defined(MFC_OpenACC)
19608# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19609!$acc exit data delete(Re_avg_rsz_vf)
19610# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19611#elif defined(MFC_OpenMP)
19612# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19613!$omp target exit data map(release:Re_avg_rsz_vf)
19614# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19615#endif
19616# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19617 deallocate (re_avg_rsz_vf)
19618 end if
19619#ifdef MFC_DEBUG
19620# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19621 block
19622# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19623 use iso_fortran_env, only: output_unit
19624# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19625
19626# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19627 print *, 'm_riemann_solvers.fpp:4647: ', '@:DEALLOCATE(vel_src_rsz_vf)'
19628# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19629
19630# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19631 call flush (output_unit)
19632# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19633 end block
19634# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19635#endif
19636# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19637
19638# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19639#if defined(MFC_OpenACC)
19640# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19641!$acc exit data delete(vel_src_rsz_vf)
19642# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19643#elif defined(MFC_OpenMP)
19644# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19645!$omp target exit data map(release:vel_src_rsz_vf)
19646# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19647#endif
19648# 4647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19649 deallocate (vel_src_rsz_vf)
19650#ifdef MFC_DEBUG
19651# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19652 block
19653# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19654 use iso_fortran_env, only: output_unit
19655# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19656
19657# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19658 print *, 'm_riemann_solvers.fpp:4648: ', '@:DEALLOCATE(flux_rsz_vf)'
19659# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19660
19661# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19662 call flush (output_unit)
19663# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19664 end block
19665# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19666#endif
19667# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19668
19669# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19670#if defined(MFC_OpenACC)
19671# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19672!$acc exit data delete(flux_rsz_vf)
19673# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19674#elif defined(MFC_OpenMP)
19675# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19676!$omp target exit data map(release:flux_rsz_vf)
19677# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19678#endif
19679# 4648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19680 deallocate (flux_rsz_vf)
19681#ifdef MFC_DEBUG
19682# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19683 block
19684# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19685 use iso_fortran_env, only: output_unit
19686# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19687
19688# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19689 print *, 'm_riemann_solvers.fpp:4649: ', '@:DEALLOCATE(flux_src_rsz_vf)'
19690# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19691
19692# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19693 call flush (output_unit)
19694# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19695 end block
19696# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19697#endif
19698# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19699
19700# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19701#if defined(MFC_OpenACC)
19702# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19703!$acc exit data delete(flux_src_rsz_vf)
19704# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19705#elif defined(MFC_OpenMP)
19706# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19707!$omp target exit data map(release:flux_src_rsz_vf)
19708# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19709#endif
19710# 4649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19711 deallocate (flux_src_rsz_vf)
19712#ifdef MFC_DEBUG
19713# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19714 block
19715# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19716 use iso_fortran_env, only: output_unit
19717# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19718
19719# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19720 print *, 'm_riemann_solvers.fpp:4650: ', '@:DEALLOCATE(flux_gsrc_rsz_vf)'
19721# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19722
19723# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19724 call flush (output_unit)
19725# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19726 end block
19727# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19728#endif
19729# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19730
19731# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19732#if defined(MFC_OpenACC)
19733# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19734!$acc exit data delete(flux_gsrc_rsz_vf)
19735# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19736#elif defined(MFC_OpenMP)
19737# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19738!$omp target exit data map(release:flux_gsrc_rsz_vf)
19739# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19740#endif
19741# 4650 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19742 deallocate (flux_gsrc_rsz_vf)
19743 if (qbmm) then
19744#ifdef MFC_DEBUG
19745# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19746 block
19747# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19748 use iso_fortran_env, only: output_unit
19749# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19750
19751# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19752 print *, 'm_riemann_solvers.fpp:4652: ', '@:DEALLOCATE(mom_sp_rsz_vf)'
19753# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19754
19755# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19756 call flush (output_unit)
19757# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19758 end block
19759# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19760#endif
19761# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19762
19763# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19764#if defined(MFC_OpenACC)
19765# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19766!$acc exit data delete(mom_sp_rsz_vf)
19767# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19768#elif defined(MFC_OpenMP)
19769# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19770!$omp target exit data map(release:mom_sp_rsz_vf)
19771# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19772#endif
19773# 4652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19774 deallocate (mom_sp_rsz_vf)
19775 end if
19776
19777 end subroutine s_finalize_riemann_solvers_module
19778
19779end module m_riemann_solvers
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1064
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1064
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1064
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:1045
m_global_parameters::contxb
integer contxb
Definition m_global_parameters.fpp.f90:1267
m_global_parameters::re_size
integer, dimension(2) re_size
Definition m_global_parameters.fpp.f90:859
m_global_parameters::bulk_stress
logical bulk_stress
Bulk stresses.
Definition m_global_parameters.fpp.f90:496
m_global_parameters::bubxb
integer bubxb
Definition m_global_parameters.fpp.f90:1269
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::xibeg
integer xibeg
Definition m_global_parameters.fpp.f90:1272
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:861
m_global_parameters::momxe
integer momxe
Definition m_global_parameters.fpp.f90:1265
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:1401
m_global_parameters::n_idx
integer n_idx
Index of number density.
Definition m_global_parameters.fpp.f90:776
m_global_parameters::dummy
logical dummy
AMDFlang workaround for case-optimization + GPU-kernel bug.
Definition m_global_parameters.fpp.f90:1380
m_global_parameters::xiend
integer xiend
Definition m_global_parameters.fpp.f90:1272
m_global_parameters::sys_size
integer sys_size
Number of unknowns in system of eqns.
Definition m_global_parameters.fpp.f90:772
m_global_parameters::weight
real(wp), dimension(:), allocatable weight
Simpson quadrature weights.
Definition m_global_parameters.fpp.f90:1031
m_global_parameters::advxe
integer advxe
Definition m_global_parameters.fpp.f90:1266
m_global_parameters::cyl_coord
logical cyl_coord
Definition m_global_parameters.fpp.f90:365
m_global_parameters::strxe
integer strxe
Definition m_global_parameters.fpp.f90:1270
m_global_parameters::dir_idx
integer, dimension(3) dir_idx
Definition m_global_parameters.fpp.f90:897
m_global_parameters::chemxb
integer chemxb
Definition m_global_parameters.fpp.f90:1271
m_global_parameters::viscous
logical viscous
Viscous effects.
Definition m_global_parameters.fpp.f90:463
m_global_parameters::b_idx
type(int_bounds_info) b_idx
Indexes of first and last magnetic field eqns.
Definition m_global_parameters.fpp.f90:783
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:947
m_global_parameters::chemxe
integer chemxe
Definition m_global_parameters.fpp.f90:1271
m_global_parameters::dir_idx_tau
integer, dimension(3) dir_idx_tau
used for hypoelasticity=true
Definition m_global_parameters.fpp.f90:899
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:1032
m_global_parameters::chem_params
type(chemistry_parameters) chem_params
Definition m_global_parameters.fpp.f90:1150
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:1046
m_global_parameters::strxb
integer strxb
Definition m_global_parameters.fpp.f90:1270
m_global_parameters::qbmm
logical qbmm
Quadrature moment method.
Definition m_global_parameters.fpp.f90:1104
m_global_parameters::damage_idx
integer damage_idx
Index of damage state variable (D) for continuum damage model.
Definition m_global_parameters.fpp.f90:790
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:1366
m_global_parameters::contxe
integer contxe
Definition m_global_parameters.fpp.f90:1267
m_global_parameters::b_size
integer b_size
Number of elements in the symmetric b tensor, plus one.
Definition m_global_parameters.fpp.f90:786
m_global_parameters::qvs
real(wp), dimension(:), allocatable qvs
Definition m_global_parameters.fpp.f90:1318
m_global_parameters::pi_infs
real(wp), dimension(:), allocatable pi_infs
Definition m_global_parameters.fpp.f90:1318
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:1060
m_global_parameters::dir_flg
real(wp), dimension(3) dir_flg
Definition m_global_parameters.fpp.f90:898
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:928
m_global_parameters::e_idx
integer e_idx
Index of energy equation.
Definition m_global_parameters.fpp.f90:775
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:1251
m_global_parameters::intxb
integer intxb
Definition m_global_parameters.fpp.f90:1268
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:1012
m_global_parameters::c_idx
integer c_idx
Index of color function.
Definition m_global_parameters.fpp.f90:789
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::psi_idx
integer psi_idx
Index of hyperbolic cleaning state variable for MHD.
Definition m_global_parameters.fpp.f90:791
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:1318
m_global_parameters::intxe
integer intxe
Definition m_global_parameters.fpp.f90:1268
m_global_parameters::bubxe
integer bubxe
Definition m_global_parameters.fpp.f90:1269
m_global_parameters::alf_idx
integer alf_idx
Index of void fraction.
Definition m_global_parameters.fpp.f90:780
m_global_parameters::advxb
integer advxb
Definition m_global_parameters.fpp.f90:1266
m_global_parameters::momxb
integer momxb
Definition m_global_parameters.fpp.f90:1265
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:15255
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:18283
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:18495
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:18685
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:16781
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:18721
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:19199
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:6432
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:18642
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:3640
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:17862
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:16026
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:2626
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:2542
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:405
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