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# 8 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
15
16! For moving immersed boundaries in simulation
17# 12 "/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# 60 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
332
333# 70 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
334
335# 94 "/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 implicit none
353
354 private; public :: s_initialize_riemann_solvers_module, s_riemann_solver, s_hll_riemann_solver, s_hllc_riemann_solver, &
355 & s_hlld_riemann_solver, s_lf_riemann_solver, s_finalize_riemann_solvers_module
356
357 !> The cell-boundary values of the fluxes (src - source) that are computed through the chosen Riemann problem solver, and the
358 !! 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,
359 !! dy or dz.
360 !> @{
361 real(wp), allocatable, dimension(:,:,:,:) :: flux_rsx_vf, flux_src_rsx_vf
362
363# 35 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
364#if defined(MFC_OpenACC)
365# 35 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
366!$acc declare create(flux_rsx_vf, flux_src_rsx_vf)
367# 35 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
368#elif defined(MFC_OpenMP)
369# 35 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
370!$omp declare target (flux_rsx_vf, flux_src_rsx_vf)
371# 35 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
372#endif
373 !> @}
374
375 !> The cell-boundary values of the geometrical source flux that are computed through the chosen Riemann problem solver by using
376 !! the left and right states given in qK_prim_rs_vf. Currently 2D axisymmetric for inviscid only.
377 !> @{
378 real(wp), allocatable, dimension(:,:,:,:) :: flux_gsrc_rsx_vf
379
380# 42 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
381#if defined(MFC_OpenACC)
382# 42 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
383!$acc declare create(flux_gsrc_rsx_vf)
384# 42 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
385#elif defined(MFC_OpenMP)
386# 42 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
387!$omp declare target (flux_gsrc_rsx_vf)
388# 42 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
389#endif
390 !> @}
391
392 ! Cell-boundary velocity from Riemann solution; used for source flux
393
394 real(wp), allocatable, dimension(:,:,:,:) :: vel_src_rsx_vf
395
396# 48 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
397#if defined(MFC_OpenACC)
398# 48 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
399!$acc declare create(vel_src_rsx_vf)
400# 48 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
401#elif defined(MFC_OpenMP)
402# 48 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
403!$omp declare target (vel_src_rsx_vf)
404# 48 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
405#endif
406
407 real(wp), allocatable, dimension(:,:,:,:) :: mom_sp_rsx_vf
408
409# 51 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
410#if defined(MFC_OpenACC)
411# 51 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
412!$acc declare create(mom_sp_rsx_vf)
413# 51 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
414#elif defined(MFC_OpenMP)
415# 51 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
416!$omp declare target (mom_sp_rsx_vf)
417# 51 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
418#endif
419
420 real(wp), allocatable, dimension(:,:,:,:) :: re_avg_rsx_vf
421
422# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
423#if defined(MFC_OpenACC)
424# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
425!$acc declare create(Re_avg_rsx_vf)
426# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
427#elif defined(MFC_OpenMP)
428# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
429!$omp declare target (Re_avg_rsx_vf)
430# 54 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
431#endif
432
433 !> @name Indical bounds in the s1-, s2- and s3-directions
434 !> @{
435 type(int_bounds_info) :: is1, is2, is3
436 type(int_bounds_info) :: isx, isy, isz
437 !> @}
438
439
440# 62 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
441#if defined(MFC_OpenACC)
442# 62 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
443!$acc declare create(is1, is2, is3, isx, isy, isz)
444# 62 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
445#elif defined(MFC_OpenMP)
446# 62 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
447!$omp declare target (is1, is2, is3, isx, isy, isz)
448# 62 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
449#endif
450
451 real(wp), allocatable, dimension(:) :: gs_rs
452
453# 65 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
454#if defined(MFC_OpenACC)
455# 65 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
456!$acc declare create(Gs_rs)
457# 65 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
458#elif defined(MFC_OpenMP)
459# 65 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
460!$omp declare target (Gs_rs)
461# 65 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
462#endif
463
464 real(wp), allocatable, dimension(:,:) :: res_gs
465
466# 68 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
467#if defined(MFC_OpenACC)
468# 68 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
469!$acc declare create(Res_gs)
470# 68 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
471#elif defined(MFC_OpenMP)
472# 68 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
473!$omp declare target (Res_gs)
474# 68 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
475#endif
476
477contains
478
479 !> Dispatch to the subroutines that are utilized to compute the Riemann problem solution. For additional information please
480 !! reference: 1) s_hll_riemann_solver 2) s_hllc_riemann_solver 3) s_lf_riemann_solver 4) s_hlld_riemann_solver
481 subroutine s_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, &
482
483 & qL_prim_vf, qR_prim_rsx_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, flux_vf, &
484 & flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
485
486 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, qr_prim_rsx_vf
487 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
488 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
489 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
490 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
491
492 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
493 integer, intent(in) :: norm_dir
494 type(int_bounds_info), intent(in) :: ix, iy, iz
495
496# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
497 if (riemann_solver == 1) then
498 call s_hll_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, &
499 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, &
500 & q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
501 end if
502# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
503 if (riemann_solver == 2) then
504 call s_hllc_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, &
505 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, &
506 & q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
507 end if
508# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
509 if (riemann_solver == 4) then
510 call s_hlld_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, &
511 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, &
512 & q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
513 end if
514# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
515 if (riemann_solver == 5) then
516 call s_lf_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, &
517 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, &
518 & q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
519 end if
520# 96 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
521
522 end subroutine s_riemann_solver
523
524 !> Dispatch to the subroutines that are utilized to compute the viscous source fluxes for either Cartesian or cylindrical
525 !! geometries. For more information please refer to: 1) s_compute_cartesian_viscous_source_flux 2)
526 !! s_compute_cylindrical_viscous_source_flux
527 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, &
528
529 & dvelR_dz_vf, flux_src_vf, norm_dir, ix, iy, iz)
530
531 type(scalar_field), dimension(num_vels), intent(in) :: velL_vf, velR_vf, dvelL_dx_vf, dvelR_dx_vf, dvelL_dy_vf, &
532 & dvelR_dy_vf, dvelL_dz_vf, dvelR_dz_vf
533
534 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
535 integer, intent(in) :: norm_dir
536 type(int_bounds_info), intent(in) :: ix, iy, iz
537
538 if (grid_geometry == 3) then
539 call s_compute_cylindrical_viscous_source_flux(vell_vf, dvell_dx_vf, dvell_dy_vf, dvell_dz_vf, velr_vf, dvelr_dx_vf, &
540 & dvelr_dy_vf, dvelr_dz_vf, flux_src_vf, norm_dir, ix, iy, iz)
541 else
542 call s_compute_cartesian_viscous_source_flux(dvell_dx_vf, dvell_dy_vf, dvell_dz_vf, dvelr_dx_vf, dvelr_dy_vf, &
543 & dvelr_dz_vf, flux_src_vf, norm_dir)
544 end if
545
546 end subroutine s_compute_viscous_source_flux
547
548 !> HLL approximate Riemann solver, Harten et al. SIAM Review (1983)
549 subroutine s_hll_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, &
550
551 & dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, &
552 & flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
553
554 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, qr_prim_rsx_vf
555 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
556 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
557 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
558 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
559
560 ! Intercell fluxes
561 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
562 real(wp) :: flux_tau_l, flux_tau_r
563 integer, intent(in) :: norm_dir
564 type(int_bounds_info), intent(in) :: ix, iy, iz
565
566# 149 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
567 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
568 real(wp), dimension(num_vels) :: vel_l, vel_r
569 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
570 real(wp), dimension(num_species) :: ys_l, ys_r
571 real(wp), dimension(num_species) :: cp_il, cp_ir, xs_l, xs_r, gamma_il, gamma_ir
572 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
573# 156 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
574 real(wp) :: rho_l, rho_r
575 real(wp) :: pres_l, pres_r
576 real(wp) :: e_l, e_r
577 real(wp) :: h_l, h_r
578 real(wp) :: cp_avg, cv_avg, t_avg, eps, c_sum_yi_phi
579 real(wp) :: t_l, t_r
580 real(wp) :: y_l, y_r
581 real(wp) :: mw_l, mw_r
582 real(wp) :: r_gas_l, r_gas_r
583 real(wp) :: cp_l, cp_r
584 real(wp) :: cv_l, cv_r
585 real(wp) :: gamm_l, gamm_r
586 real(wp) :: gamma_l, gamma_r
587 real(wp) :: pi_inf_l, pi_inf_r
588 real(wp) :: qv_l, qv_r
589 real(wp) :: c_l, c_r
590 real(wp), dimension(6) :: tau_e_l, tau_e_r
591 real(wp) :: g_l, g_r
592 real(wp), dimension(2) :: re_l, re_r
593 real(wp), dimension(3) :: xi_field_l, xi_field_r
594 real(wp) :: rho_avg
595 real(wp) :: h_avg
596 real(wp) :: qv_avg
597 real(wp) :: gamma_avg
598 real(wp) :: c_avg
599 real(wp) :: s_l, s_r, s_m, s_p, s_s
600 real(wp) :: xi_m, xi_p
601 real(wp) :: ptilde_l, ptilde_r
602 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
603 real(wp) :: vel_l_tmp, vel_r_tmp
604 real(wp) :: ms_l, ms_r, pres_sl, pres_sr
605 real(wp) :: alpha_l_sum, alpha_r_sum
606 real(wp) :: zcoef, pcorr !< low Mach number correction
607 type(riemann_states) :: c_fast, pres_mag
608 type(riemann_states_vec3) :: b
609 type(riemann_states) :: ga !< Gamma (Lorentz factor)
610 type(riemann_states) :: vdotb, b2
611 type(riemann_states_vec3) :: b4 !< 4-magnetic field components (spatial: b4x, b4y, b4z)
612 type(riemann_states_vec3) :: cm !< Conservative momentum variables
613 integer :: i, j, k, l, q !< Generic loop iterators
614 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
615
616 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
617 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
618
619 ! Reshaping inputted data based on dimensional splitting direction
620 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
621# 207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
622# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
623# 209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
624 if (norm_dir == 1) then
625
626# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
627
628# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
629#if defined(MFC_OpenACC)
630# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
631!$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)
632# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
633#elif defined(MFC_OpenMP)
634# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
635
636# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
637
638# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
639
640# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
641!$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)
642# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
643#endif
644# 219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
645 do l = is3%beg, is3%end
646 do k = is2%beg, is2%end
647 do j = is1%beg, is1%end
648
649# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
650#if defined(MFC_OpenACC)
651# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
652!$acc loop seq
653# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
654#elif defined(MFC_OpenMP)
655# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
656
657# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
658#endif
659 do i = 1, eqn_idx%cont%end
660 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
661 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
662 end do
663
664 vel_l_rms = 0._wp; vel_r_rms = 0._wp
665
666
667# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
668#if defined(MFC_OpenACC)
669# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
670!$acc loop seq
671# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
672#elif defined(MFC_OpenMP)
673# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
674
675# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
676#endif
677 do i = 1, num_vels
678 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
679 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
680 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
681 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
682 end do
683
684
685# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
686#if defined(MFC_OpenACC)
687# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
688!$acc loop seq
689# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
690#elif defined(MFC_OpenMP)
691# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
692
693# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
694#endif
695 do i = 1, num_fluids
696 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
697 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
698 end do
699
700 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
701 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
702
703 if (mhd) then
704 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
705 b%L(1) = bx0
706 b%R(1) = bx0
707 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
708 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg)
709 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
710 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 1)
711 else ! 2D/3D: Bx, By, Bz as variables
712 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
713 b%R(1) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg)
714 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
715 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 1)
716 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
717 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 2)
718 end if
719 end if
720
721 rho_l = 0._wp
722 gamma_l = 0._wp
723 pi_inf_l = 0._wp
724 qv_l = 0._wp
725
726 rho_r = 0._wp
727 gamma_r = 0._wp
728 pi_inf_r = 0._wp
729 qv_r = 0._wp
730
731 alpha_l_sum = 0._wp
732 alpha_r_sum = 0._wp
733
734 pres_mag%L = 0._wp
735 pres_mag%R = 0._wp
736
737 if (mpp_lim) then
738
739# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
740#if defined(MFC_OpenACC)
741# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
742!$acc loop seq
743# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
744#elif defined(MFC_OpenMP)
745# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
746
747# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
748#endif
749 do i = 1, num_fluids
750 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
751 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
752 alpha_l_sum = alpha_l_sum + alpha_l(i)
753 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
754 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
755 alpha_r_sum = alpha_r_sum + alpha_r(i)
756 end do
757
758 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
759 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
760 end if
761
762
763# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
764#if defined(MFC_OpenACC)
765# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
766!$acc loop seq
767# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
768#elif defined(MFC_OpenMP)
769# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
770
771# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
772#endif
773 do i = 1, num_fluids
774 rho_l = rho_l + alpha_rho_l(i)
775 gamma_l = gamma_l + alpha_l(i)*gammas(i)
776 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
777 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
778
779 rho_r = rho_r + alpha_rho_r(i)
780 gamma_r = gamma_r + alpha_r(i)*gammas(i)
781 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
782 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
783 end do
784
785 if (viscous) then
786
787# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
788#if defined(MFC_OpenACC)
789# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
790!$acc loop seq
791# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
792#elif defined(MFC_OpenMP)
793# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
794
795# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
796#endif
797 do i = 1, 2
798 re_l(i) = dflt_real
799 re_r(i) = dflt_real
800
801 if (re_size(i) > 0) re_l(i) = 0._wp
802 if (re_size(i) > 0) re_r(i) = 0._wp
803
804
805# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
806#if defined(MFC_OpenACC)
807# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
808!$acc loop seq
809# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
810#elif defined(MFC_OpenMP)
811# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
812
813# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
814#endif
815 do q = 1, re_size(i)
816 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
817 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
818 end do
819
820 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
821 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
822 end do
823 end if
824
825 if (chemistry) then
826
827# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
828#if defined(MFC_OpenACC)
829# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
830!$acc loop seq
831# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
832#elif defined(MFC_OpenMP)
833# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
834
835# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
836#endif
837 do i = eqn_idx%species%beg, eqn_idx%species%end
838 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
839 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
840 end do
841
842 call get_mixture_molecular_weight(ys_l, mw_l)
843 call get_mixture_molecular_weight(ys_r, mw_r)
844 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
845 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
846
847 r_gas_l = gas_constant/mw_l
848 r_gas_r = gas_constant/mw_r
849 t_l = pres_l/rho_l/r_gas_l
850 t_r = pres_r/rho_r/r_gas_r
851
852 call get_species_specific_heats_r(t_l, cp_il)
853 call get_species_specific_heats_r(t_r, cp_ir)
854
855 if (chem_params%gamma_method == 1) then
856 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
857 gamma_il = cp_il/(cp_il - 1.0_wp)
858 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
859
860 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
861 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
862 else if (chem_params%gamma_method == 2) then
863 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
864 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
865 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
866 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
867 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
868
869 gamm_l = cp_l/cv_l
870 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
871 gamm_r = cp_r/cv_r
872 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
873 end if
874
875 call get_mixture_energy_mass(t_l, ys_l, e_l)
876 call get_mixture_energy_mass(t_r, ys_r, e_r)
877
878 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
879 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
880 h_l = (e_l + pres_l)/rho_l
881 h_r = (e_r + pres_r)/rho_r
882 else if (mhd .and. relativity) then
883 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
884 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
885# 380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
886 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
887 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
888
889 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
890 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
891 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
892 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
893# 388 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
894
895 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
896 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
897
898 ! Hard-coded EOS
899 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
900 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
901# 396 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
902 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
903 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
904# 399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
905
906 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
907 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
908 else if (mhd .and. .not. relativity) then
909# 404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
910 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
911 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
912# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
913 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
914 ! includes magnetic energy
915 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R
916 h_l = (e_l + pres_l - pres_mag%L)/rho_l
917 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
918 h_r = (e_r + pres_r - pres_mag%R)/rho_r
919 else
920 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
921 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
922 h_l = (e_l + pres_l)/rho_l
923 h_r = (e_r + pres_r)/rho_r
924 end if
925
926 ! elastic energy update
927 if (hypoelasticity) then
928 g_l = 0._wp; g_r = 0._wp
929
930
931# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
932#if defined(MFC_OpenACC)
933# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
934!$acc loop seq
935# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
936#elif defined(MFC_OpenMP)
937# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
938
939# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
940#endif
941 do i = 1, num_fluids
942 g_l = g_l + alpha_l(i)*gs_rs(i)
943 g_r = g_r + alpha_r(i)*gs_rs(i)
944 end do
945
946 if (cont_damage) then
947 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
948 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
949 end if
950
951
952# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
953#if defined(MFC_OpenACC)
954# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
955!$acc loop seq
956# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
957#elif defined(MFC_OpenMP)
958# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
959
960# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
961#endif
962 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
963 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
964 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
965 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
966 if ((g_l > 1000) .and. (g_r > 1000)) then
967 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
968 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
969 ! Double for shear stresses
970 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
971 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
972 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
973 end if
974 end if
975 end do
976 end if
977
978 if (avg_state == 1) then
979# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
980 rho_avg = sqrt(rho_l*rho_r)
981# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
982
983# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
984 vel_avg_rms = 0._wp
985# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
986
987# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
988
989# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
990#if defined(MFC_OpenACC)
991# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
992!$acc loop seq
993# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
994#elif defined(MFC_OpenMP)
995# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
996
997# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
998#endif
999# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1000 do i = 1, num_vels
1001# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1002 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
1003# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1004 end do
1005# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1006
1007# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1008 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
1009# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1010
1011# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1012 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
1013# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1014
1015# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1016 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
1017# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1018
1019# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1020 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
1021# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1022
1023# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1024 if (chemistry) then
1025# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1026 eps = 0.001_wp
1027# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1028 call get_species_enthalpies_rt(t_l, h_il)
1029# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1030 call get_species_enthalpies_rt(t_r, h_ir)
1031# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1032 h_il = h_il*gas_constant/molecular_weights*t_l
1033# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1034 h_ir = h_ir*gas_constant/molecular_weights*t_r
1035# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1036 call get_species_specific_heats_r(t_l, cp_il)
1037# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1038 call get_species_specific_heats_r(t_r, cp_ir)
1039# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1040
1041# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1042 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
1043# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1044 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
1045# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1046 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
1047# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1048 if (abs(t_l - t_r) < eps) then
1049# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1050 ! Case when T_L and T_R are very close
1051# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1052 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
1053# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1054 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
1055# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1056 & - gas_constant/molecular_weights(:)))
1057# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1058 else
1059# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1060 ! Normal calculation when T_L and T_R are sufficiently different
1061# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1062 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
1063# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1064 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
1065# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1066 end if
1067# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1068 gamma_avg = cp_avg/cv_avg
1069# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1070
1071# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1072 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
1073# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1074 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
1075# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1076 end if
1077# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1078 end if
1079# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1080
1081# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1082 if (avg_state == 2) then
1083# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1084 rho_avg = 5.e-1_wp*(rho_l + rho_r)
1085# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1086 vel_avg_rms = 0._wp
1087# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1088
1089# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1090#if defined(MFC_OpenACC)
1091# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1092!$acc loop seq
1093# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1094#elif defined(MFC_OpenMP)
1095# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1096
1097# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1098#endif
1099# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1100 do i = 1, num_vels
1101# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1102 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
1103# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1104 end do
1105# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1106
1107# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1108 h_avg = 5.e-1_wp*(h_l + h_r)
1109# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1110 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
1111# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1112 qv_avg = 5.e-1_wp*(qv_l + qv_r)
1113# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1114 end if
1115
1116 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, &
1117 & qv_l)
1118
1119 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, &
1120 & qv_r)
1121
1122 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
1123 ! variables are placeholders to call the subroutine.
1124
1125 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
1126 & c_sum_yi_phi, c_avg, qv_avg)
1127
1128 if (mhd) then
1129 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
1130 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
1131 end if
1132
1133 if (viscous) then
1134 if (chemistry) then
1135 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
1136 end if
1137
1138# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1139#if defined(MFC_OpenACC)
1140# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1141!$acc loop seq
1142# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1143#elif defined(MFC_OpenMP)
1144# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1145
1146# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1147#endif
1148 do i = 1, 2
1149 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
1150 end do
1151 end if
1152
1153 ! Wave speed estimates (wave_speeds=1: direct, wave_speeds=2: pressure-based)
1154 if (wave_speeds == 1) then
1155 if (mhd) then
1156 ! MHD: use fast magnetosonic speed
1157 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
1158 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
1159 else if (hypoelasticity) then
1160 ! Elastic wave speed, Rodriguez et al. JCP (2019)
1161 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))) &
1162 & /rho_l), &
1163 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
1164 & /rho_r))
1165 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))) &
1166 & /rho_r), &
1167 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
1168 & /rho_l))
1169 else if (hyperelasticity) then
1170 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l), &
1171 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
1172 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r), &
1173 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
1174 else
1175 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
1176 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
1177 end if
1178
1179 if (hyper_cleaning) then
1180 ! Dedner GLM divergence cleaning, Dedner et al. JCP (2002)
1181 s_l = min(s_l, -hyper_cleaning_speed)
1182 s_r = max(s_r, hyper_cleaning_speed)
1183 end if
1184
1185 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
1186 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
1187 & - rho_r*(s_r - vel_r(dir_idx(1))))
1188 else if (wave_speeds == 2) then
1189 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1190
1191 pres_sr = pres_sl
1192
1193 ! Low Mach correction: Thornber et al. JCP (2008)
1194 ms_l = max(1._wp, &
1195 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
1196 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
1197 ms_r = max(1._wp, &
1198 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
1199 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
1200
1201 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1202 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1203
1204 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
1205 end if
1206
1207 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1208
1209 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, &
1210 & s_r))
1211 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, &
1212 & s_r))
1213
1214 ! 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
1215 if (low_mach == 1) then
1216 if (riemann_solver == 1 .or. riemann_solver == 5) then
1217# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1218 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1219# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1220 pcorr = 0._wp
1221# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1222
1223# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1224 if (low_mach == 1) then
1225# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1226 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
1227# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1228 end if
1229# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1230 else if (riemann_solver == 2) then
1231# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1232 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1233# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1234 pcorr = 0._wp
1235# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1236
1237# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1238 if (low_mach == 1) then
1239# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1240 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))) &
1241# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1242 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
1243# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1244 else if (low_mach == 2) then
1245# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1246 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))))
1247# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1248 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))))
1249# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1250 vel_l(dir_idx(1)) = vel_l_tmp
1251# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1252 vel_r(dir_idx(1)) = vel_r_tmp
1253# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1254 end if
1255# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1256 end if
1257 else
1258 pcorr = 0._wp
1259 end if
1260
1261 ! Mass
1262 if (.not. relativity) then
1263
1264# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1265#if defined(MFC_OpenACC)
1266# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1267!$acc loop seq
1268# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1269#elif defined(MFC_OpenMP)
1270# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1271
1272# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1273#endif
1274 do i = 1, eqn_idx%cont%end
1275 flux_rsx_vf(j, k, l, &
1276 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
1277 & + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
1278 end do
1279 else if (relativity) then
1280
1281# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1282#if defined(MFC_OpenACC)
1283# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1284!$acc loop seq
1285# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1286#elif defined(MFC_OpenMP)
1287# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1288
1289# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1290#endif
1291 do i = 1, eqn_idx%cont%end
1292 flux_rsx_vf(j, k, l, &
1293 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
1294 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i)))/(s_m &
1295 & - s_p)
1296 end do
1297 end if
1298
1299 ! Momentum
1300 if (mhd .and. (.not. relativity)) then
1301
1302# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1303#if defined(MFC_OpenACC)
1304# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1305!$acc loop seq
1306# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1307#elif defined(MFC_OpenMP)
1308# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1309
1310# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1311#endif
1312 do i = 1, 3
1313 ! Flux of rho*v_i in the x direction = rho * v_i * v_x - B_i * B_x +
1314 ! delta_(x,i) * p_tot
1315 flux_rsx_vf(j, k, l, &
1316 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
1317 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
1318 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
1319 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
1320 end do
1321 else if (mhd .and. relativity) then
1322
1323# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1324#if defined(MFC_OpenACC)
1325# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1326!$acc loop seq
1327# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1328#elif defined(MFC_OpenMP)
1329# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1330
1331# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1332#endif
1333 do i = 1, 3
1334 ! Flux of m_i in the x direction = m_i * v_x - b_i/Gamma * B_x +
1335 ! delta_(x,i) * p_tot
1336 flux_rsx_vf(j, k, l, &
1337 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
1338 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
1339 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
1340 & ) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
1341 end do
1342 else if (bubbles_euler) then
1343
1344# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1345#if defined(MFC_OpenACC)
1346# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1347!$acc loop seq
1348# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1349#elif defined(MFC_OpenMP)
1350# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1351
1352# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1353#endif
1354 do i = 1, num_vels
1355 flux_rsx_vf(j, k, l, &
1356 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1357 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
1358 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
1359 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
1360 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
1361 end do
1362 else if (hypoelasticity) then
1363
1364# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1365#if defined(MFC_OpenACC)
1366# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1367!$acc loop seq
1368# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1369#elif defined(MFC_OpenMP)
1370# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1371
1372# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1373#endif
1374 do i = 1, num_vels
1375 flux_rsx_vf(j, k, l, &
1376 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1377 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
1378 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l &
1379 & - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
1380 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
1381 end do
1382 else
1383
1384# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1385#if defined(MFC_OpenACC)
1386# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1387!$acc loop seq
1388# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1389#elif defined(MFC_OpenMP)
1390# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1391
1392# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1393#endif
1394 do i = 1, num_vels
1395 flux_rsx_vf(j, k, l, &
1396 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1397 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
1398 & + dir_flg(dir_idx(i))*pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
1399 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
1400 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
1401 end do
1402 end if
1403
1404 ! Energy
1405 if (mhd .and. (.not. relativity)) then
1406 ! energy flux = (E + p + p_mag) * v_x - B_x * (v_x*B_x + v_y*B_y + v_z*B_z)
1407# 626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1408 flux_rsx_vf(j, k, l, &
1409 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
1410 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) - s_p*(vel_l(norm_dir) &
1411 & *(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) &
1412 & + vel_l(3)*b%L(3))) + s_m*s_p*(e_l - e_r))/(s_m - s_p)
1413# 632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1414 else if (mhd .and. relativity) then
1415 ! energy flux = m_x - mass flux Hard-coded for single-component for now
1416 flux_rsx_vf(j, k, l, &
1417 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
1418 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l - e_r)) &
1419 & /(s_m - s_p)
1420 else if (bubbles_euler) then
1421 flux_rsx_vf(j, k, l, &
1422 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) - s_p*vel_l(dir_idx(1) &
1423 & )*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
1424 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
1425 else if (hypoelasticity) then
1426 flux_tau_l = 0._wp; flux_tau_r = 0._wp
1427
1428# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1429#if defined(MFC_OpenACC)
1430# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1431!$acc loop seq
1432# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1433#elif defined(MFC_OpenMP)
1434# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1435
1436# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1437#endif
1438 do i = 1, num_dims
1439 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
1440 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
1441 end do
1442 flux_rsx_vf(j, k, l, &
1443 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
1444 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r))/(s_m &
1445 & - s_p)
1446 else
1447 flux_rsx_vf(j, k, l, &
1448 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
1449 & + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms &
1450 & - vel_l_rms)/2._wp
1451 end if
1452
1453 ! Elastic Stresses
1454 if (hypoelasticity) then
1455 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
1456 flux_rsx_vf(j, k, l, &
1457 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
1458 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
1459 & - rho_r*tau_e_r(i)))/(s_m - s_p)
1460 end do
1461 end if
1462
1463 ! Advection flux and source: interface velocity for volume fraction transport
1464
1465# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1466#if defined(MFC_OpenACC)
1467# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1468!$acc loop seq
1469# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1470#elif defined(MFC_OpenMP)
1471# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1472
1473# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1474#endif
1475 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1476 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j + 1, k, l, &
1477 & i))*s_m*s_p/(s_m - s_p)
1478 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j + 1, k, l, &
1479 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
1480 end do
1481
1482 if (bubbles_euler) then
1483 ! From HLLC: Kills mass transport @ bubble gas density
1484 if (num_fluids > 1) then
1485 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
1486 end if
1487 end if
1488
1489 if (chemistry) then
1490
1491# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1492#if defined(MFC_OpenACC)
1493# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1494!$acc loop seq
1495# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1496#elif defined(MFC_OpenMP)
1497# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1498
1499# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1500#endif
1501 do i = eqn_idx%species%beg, eqn_idx%species%end
1502 y_l = ql_prim_rsx_vf(j, k, l, i)
1503 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
1504
1505 flux_rsx_vf(j, k, l, &
1506 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
1507 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
1508 flux_src_rsx_vf(j, k, l, i) = 0._wp
1509 end do
1510 end if
1511
1512 ! MHD: magnetic flux and Maxwell stress contributions
1513 if (mhd) then
1514 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
1515 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
1516
1517# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1518#if defined(MFC_OpenACC)
1519# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1520!$acc loop seq
1521# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1522#elif defined(MFC_OpenMP)
1523# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1524
1525# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1526#endif
1527 do i = 0, 1
1528 flux_rsx_vf(j, k, l, &
1529 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
1530 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
1531 & - b%R(2 + i)))/(s_m - s_p)
1532 end do
1533 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
1534 ! B_x d/dx flux = (1 - delta(x,x)) * (v_x * B_x - v_x * B_x) B_y
1535 ! d/dx flux = (1 - delta(y,x)) * (v_x * B_y - v_y * B_x) B_z d/dx
1536 ! flux = (1 - delta(z,x)) * (v_x * B_z - v_z * B_x)
1537
1538# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1539#if defined(MFC_OpenACC)
1540# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1541!$acc loop seq
1542# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1543#elif defined(MFC_OpenMP)
1544# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1545
1546# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1547#endif
1548 do i = 0, 2
1549 flux_rsx_vf(j, k, l, &
1550 & eqn_idx%B%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1) &
1551 & *b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1) &
1552 & *b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
1553 end do
1554
1555 if (hyper_cleaning) then
1556 ! propagate magnetic field divergence as a wave
1557 flux_rsx_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = flux_rsx_vf(j, k, l, &
1558 & eqn_idx%B%beg + norm_dir - 1) + (s_m*qr_prim_rsx_vf(j + 1, k, l, &
1559 & eqn_idx%psi) - s_p*ql_prim_rsx_vf(j, k, l, eqn_idx%psi))/(s_m - s_p)
1560
1561 flux_rsx_vf(j, k, l, &
1562 & eqn_idx%psi) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) &
1563 & - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsx_vf(j, k, l, &
1564 & eqn_idx%psi) - qr_prim_rsx_vf(j + 1, k, l, eqn_idx%psi)))/(s_m - s_p)
1565 else
1566 ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
1567 flux_rsx_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = 0._wp
1568 end if
1569 end if
1570 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
1571 end if
1572
1573# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1574 end do
1575 end do
1576 end do
1577
1578# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1579#if defined(MFC_OpenACC)
1580# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1581!$acc end parallel loop
1582# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1583#elif defined(MFC_OpenMP)
1584# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1585
1586# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1587!$omp end target teams loop
1588# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1589#endif
1590 end if
1591# 207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1592# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1593# 209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1594 if (norm_dir == 2) then
1595
1596# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1597
1598# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1599#if defined(MFC_OpenACC)
1600# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1601!$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)
1602# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1603#elif defined(MFC_OpenMP)
1604# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1605
1606# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1607
1608# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1609
1610# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1611!$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)
1612# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1613#endif
1614# 219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1615 do l = is3%beg, is3%end
1616 do k = is1%beg, is1%end
1617 do j = is2%beg, is2%end
1618
1619# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1620#if defined(MFC_OpenACC)
1621# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1622!$acc loop seq
1623# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1624#elif defined(MFC_OpenMP)
1625# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1626
1627# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1628#endif
1629 do i = 1, eqn_idx%cont%end
1630 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
1631 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
1632 end do
1633
1634 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1635
1636
1637# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1638#if defined(MFC_OpenACC)
1639# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1640!$acc loop seq
1641# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1642#elif defined(MFC_OpenMP)
1643# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1644
1645# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1646#endif
1647 do i = 1, num_vels
1648 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
1649 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
1650 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1651 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1652 end do
1653
1654
1655# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1656#if defined(MFC_OpenACC)
1657# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1658!$acc loop seq
1659# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1660#elif defined(MFC_OpenMP)
1661# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1662
1663# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1664#endif
1665 do i = 1, num_fluids
1666 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1667 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
1668 end do
1669
1670 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1671 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
1672
1673 if (mhd) then
1674 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
1675 b%L(1) = bx0
1676 b%R(1) = bx0
1677 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
1678 b%R(2) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg)
1679 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
1680 b%R(3) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + 1)
1681 else ! 2D/3D: Bx, By, Bz as variables
1682 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
1683 b%R(1) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg)
1684 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
1685 b%R(2) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + 1)
1686 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
1687 b%R(3) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + 2)
1688 end if
1689 end if
1690
1691 rho_l = 0._wp
1692 gamma_l = 0._wp
1693 pi_inf_l = 0._wp
1694 qv_l = 0._wp
1695
1696 rho_r = 0._wp
1697 gamma_r = 0._wp
1698 pi_inf_r = 0._wp
1699 qv_r = 0._wp
1700
1701 alpha_l_sum = 0._wp
1702 alpha_r_sum = 0._wp
1703
1704 pres_mag%L = 0._wp
1705 pres_mag%R = 0._wp
1706
1707 if (mpp_lim) then
1708
1709# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1710#if defined(MFC_OpenACC)
1711# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1712!$acc loop seq
1713# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1714#elif defined(MFC_OpenMP)
1715# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1716
1717# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1718#endif
1719 do i = 1, num_fluids
1720 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
1721 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
1722 alpha_l_sum = alpha_l_sum + alpha_l(i)
1723 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
1724 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
1725 alpha_r_sum = alpha_r_sum + alpha_r(i)
1726 end do
1727
1728 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
1729 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
1730 end if
1731
1732
1733# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1734#if defined(MFC_OpenACC)
1735# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1736!$acc loop seq
1737# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1738#elif defined(MFC_OpenMP)
1739# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1740
1741# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1742#endif
1743 do i = 1, num_fluids
1744 rho_l = rho_l + alpha_rho_l(i)
1745 gamma_l = gamma_l + alpha_l(i)*gammas(i)
1746 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
1747 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
1748
1749 rho_r = rho_r + alpha_rho_r(i)
1750 gamma_r = gamma_r + alpha_r(i)*gammas(i)
1751 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
1752 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
1753 end do
1754
1755 if (viscous) then
1756
1757# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1758#if defined(MFC_OpenACC)
1759# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1760!$acc loop seq
1761# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1762#elif defined(MFC_OpenMP)
1763# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1764
1765# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1766#endif
1767 do i = 1, 2
1768 re_l(i) = dflt_real
1769 re_r(i) = dflt_real
1770
1771 if (re_size(i) > 0) re_l(i) = 0._wp
1772 if (re_size(i) > 0) re_r(i) = 0._wp
1773
1774
1775# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1776#if defined(MFC_OpenACC)
1777# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1778!$acc loop seq
1779# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1780#elif defined(MFC_OpenMP)
1781# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1782
1783# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1784#endif
1785 do q = 1, re_size(i)
1786 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
1787 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
1788 end do
1789
1790 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
1791 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
1792 end do
1793 end if
1794
1795 if (chemistry) then
1796
1797# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1798#if defined(MFC_OpenACC)
1799# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1800!$acc loop seq
1801# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1802#elif defined(MFC_OpenMP)
1803# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1804
1805# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1806#endif
1807 do i = eqn_idx%species%beg, eqn_idx%species%end
1808 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
1809 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
1810 end do
1811
1812 call get_mixture_molecular_weight(ys_l, mw_l)
1813 call get_mixture_molecular_weight(ys_r, mw_r)
1814 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
1815 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
1816
1817 r_gas_l = gas_constant/mw_l
1818 r_gas_r = gas_constant/mw_r
1819 t_l = pres_l/rho_l/r_gas_l
1820 t_r = pres_r/rho_r/r_gas_r
1821
1822 call get_species_specific_heats_r(t_l, cp_il)
1823 call get_species_specific_heats_r(t_r, cp_ir)
1824
1825 if (chem_params%gamma_method == 1) then
1826 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
1827 gamma_il = cp_il/(cp_il - 1.0_wp)
1828 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
1829
1830 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
1831 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
1832 else if (chem_params%gamma_method == 2) then
1833 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
1834 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
1835 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
1836 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
1837 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
1838
1839 gamm_l = cp_l/cv_l
1840 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
1841 gamm_r = cp_r/cv_r
1842 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
1843 end if
1844
1845 call get_mixture_energy_mass(t_l, ys_l, e_l)
1846 call get_mixture_energy_mass(t_r, ys_r, e_r)
1847
1848 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
1849 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
1850 h_l = (e_l + pres_l)/rho_l
1851 h_r = (e_r + pres_r)/rho_r
1852 else if (mhd .and. relativity) then
1853 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
1854 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
1855# 380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1856 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
1857 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
1858
1859 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
1860 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
1861 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
1862 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
1863# 388 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1864
1865 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
1866 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
1867
1868 ! Hard-coded EOS
1869 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
1870 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
1871# 396 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1872 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
1873 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
1874# 399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1875
1876 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
1877 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
1878 else if (mhd .and. .not. relativity) then
1879# 404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1880 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
1881 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
1882# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1883 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
1884 ! includes magnetic energy
1885 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R
1886 h_l = (e_l + pres_l - pres_mag%L)/rho_l
1887 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
1888 h_r = (e_r + pres_r - pres_mag%R)/rho_r
1889 else
1890 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
1891 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
1892 h_l = (e_l + pres_l)/rho_l
1893 h_r = (e_r + pres_r)/rho_r
1894 end if
1895
1896 ! elastic energy update
1897 if (hypoelasticity) then
1898 g_l = 0._wp; g_r = 0._wp
1899
1900
1901# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1902#if defined(MFC_OpenACC)
1903# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1904!$acc loop seq
1905# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1906#elif defined(MFC_OpenMP)
1907# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1908
1909# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1910#endif
1911 do i = 1, num_fluids
1912 g_l = g_l + alpha_l(i)*gs_rs(i)
1913 g_r = g_r + alpha_r(i)*gs_rs(i)
1914 end do
1915
1916 if (cont_damage) then
1917 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
1918 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
1919 end if
1920
1921
1922# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1923#if defined(MFC_OpenACC)
1924# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1925!$acc loop seq
1926# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1927#elif defined(MFC_OpenMP)
1928# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1929
1930# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1931#endif
1932 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
1933 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
1934 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
1935 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
1936 if ((g_l > 1000) .and. (g_r > 1000)) then
1937 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
1938 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
1939 ! Double for shear stresses
1940 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
1941 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
1942 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
1943 end if
1944 end if
1945 end do
1946 end if
1947
1948 if (avg_state == 1) then
1949# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1950 rho_avg = sqrt(rho_l*rho_r)
1951# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1952
1953# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1954 vel_avg_rms = 0._wp
1955# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1956
1957# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1958
1959# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1960#if defined(MFC_OpenACC)
1961# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1962!$acc loop seq
1963# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1964#elif defined(MFC_OpenMP)
1965# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1966
1967# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1968#endif
1969# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1970 do i = 1, num_vels
1971# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1972 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
1973# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1974 end do
1975# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1976
1977# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1978 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
1979# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1980
1981# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1982 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
1983# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1984
1985# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1986 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
1987# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1988
1989# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1990 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
1991# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1992
1993# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1994 if (chemistry) then
1995# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1996 eps = 0.001_wp
1997# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1998 call get_species_enthalpies_rt(t_l, h_il)
1999# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2000 call get_species_enthalpies_rt(t_r, h_ir)
2001# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2002 h_il = h_il*gas_constant/molecular_weights*t_l
2003# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2004 h_ir = h_ir*gas_constant/molecular_weights*t_r
2005# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2006 call get_species_specific_heats_r(t_l, cp_il)
2007# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2008 call get_species_specific_heats_r(t_r, cp_ir)
2009# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2010
2011# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2012 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
2013# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2014 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
2015# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2016 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
2017# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2018 if (abs(t_l - t_r) < eps) then
2019# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2020 ! Case when T_L and T_R are very close
2021# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2022 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
2023# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2024 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
2025# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2026 & - gas_constant/molecular_weights(:)))
2027# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2028 else
2029# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2030 ! Normal calculation when T_L and T_R are sufficiently different
2031# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2032 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
2033# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2034 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
2035# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2036 end if
2037# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2038 gamma_avg = cp_avg/cv_avg
2039# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2040
2041# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2042 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
2043# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2044 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
2045# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2046 end if
2047# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2048 end if
2049# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2050
2051# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2052 if (avg_state == 2) then
2053# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2054 rho_avg = 5.e-1_wp*(rho_l + rho_r)
2055# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2056 vel_avg_rms = 0._wp
2057# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2058
2059# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2060#if defined(MFC_OpenACC)
2061# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2062!$acc loop seq
2063# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2064#elif defined(MFC_OpenMP)
2065# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2066
2067# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2068#endif
2069# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2070 do i = 1, num_vels
2071# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2072 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
2073# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2074 end do
2075# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2076
2077# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2078 h_avg = 5.e-1_wp*(h_l + h_r)
2079# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2080 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
2081# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2082 qv_avg = 5.e-1_wp*(qv_l + qv_r)
2083# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2084 end if
2085
2086 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, &
2087 & qv_l)
2088
2089 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, &
2090 & qv_r)
2091
2092 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
2093 ! variables are placeholders to call the subroutine.
2094
2095 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
2096 & c_sum_yi_phi, c_avg, qv_avg)
2097
2098 if (mhd) then
2099 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
2100 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
2101 end if
2102
2103 if (viscous) then
2104 if (chemistry) then
2105 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
2106 end if
2107
2108# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2109#if defined(MFC_OpenACC)
2110# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2111!$acc loop seq
2112# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2113#elif defined(MFC_OpenMP)
2114# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2115
2116# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2117#endif
2118 do i = 1, 2
2119 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2120 end do
2121 end if
2122
2123 ! Wave speed estimates (wave_speeds=1: direct, wave_speeds=2: pressure-based)
2124 if (wave_speeds == 1) then
2125 if (mhd) then
2126 ! MHD: use fast magnetosonic speed
2127 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
2128 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
2129 else if (hypoelasticity) then
2130 ! Elastic wave speed, Rodriguez et al. JCP (2019)
2131 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))) &
2132 & /rho_l), &
2133 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
2134 & /rho_r))
2135 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))) &
2136 & /rho_r), &
2137 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
2138 & /rho_l))
2139 else if (hyperelasticity) then
2140 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l), &
2141 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
2142 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r), &
2143 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
2144 else
2145 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
2146 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
2147 end if
2148
2149 if (hyper_cleaning) then
2150 ! Dedner GLM divergence cleaning, Dedner et al. JCP (2002)
2151 s_l = min(s_l, -hyper_cleaning_speed)
2152 s_r = max(s_r, hyper_cleaning_speed)
2153 end if
2154
2155 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
2156 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
2157 & - rho_r*(s_r - vel_r(dir_idx(1))))
2158 else if (wave_speeds == 2) then
2159 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2160
2161 pres_sr = pres_sl
2162
2163 ! Low Mach correction: Thornber et al. JCP (2008)
2164 ms_l = max(1._wp, &
2165 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
2166 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
2167 ms_r = max(1._wp, &
2168 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
2169 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
2170
2171 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2172 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2173
2174 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
2175 end if
2176
2177 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2178
2179 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, &
2180 & s_r))
2181 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, &
2182 & s_r))
2183
2184 ! 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
2185 if (low_mach == 1) then
2186 if (riemann_solver == 1 .or. riemann_solver == 5) then
2187# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2188 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2189# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2190 pcorr = 0._wp
2191# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2192
2193# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2194 if (low_mach == 1) then
2195# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2196 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2197# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2198 end if
2199# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2200 else if (riemann_solver == 2) then
2201# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2202 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2203# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2204 pcorr = 0._wp
2205# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2206
2207# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2208 if (low_mach == 1) then
2209# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2210 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))) &
2211# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2212 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2213# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2214 else if (low_mach == 2) then
2215# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2216 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))))
2217# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2218 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))))
2219# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2220 vel_l(dir_idx(1)) = vel_l_tmp
2221# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2222 vel_r(dir_idx(1)) = vel_r_tmp
2223# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2224 end if
2225# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2226 end if
2227 else
2228 pcorr = 0._wp
2229 end if
2230
2231 ! Mass
2232 if (.not. relativity) then
2233
2234# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2235#if defined(MFC_OpenACC)
2236# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2237!$acc loop seq
2238# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2239#elif defined(MFC_OpenMP)
2240# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2241
2242# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2243#endif
2244 do i = 1, eqn_idx%cont%end
2245 flux_rsx_vf(j, k, l, &
2246 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
2247 & + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
2248 end do
2249 else if (relativity) then
2250
2251# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2252#if defined(MFC_OpenACC)
2253# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2254!$acc loop seq
2255# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2256#elif defined(MFC_OpenMP)
2257# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2258
2259# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2260#endif
2261 do i = 1, eqn_idx%cont%end
2262 flux_rsx_vf(j, k, l, &
2263 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
2264 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i)))/(s_m &
2265 & - s_p)
2266 end do
2267 end if
2268
2269 ! Momentum
2270 if (mhd .and. (.not. relativity)) then
2271
2272# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2273#if defined(MFC_OpenACC)
2274# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2275!$acc loop seq
2276# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2277#elif defined(MFC_OpenMP)
2278# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2279
2280# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2281#endif
2282 do i = 1, 3
2283 ! Flux of rho*v_i in the y direction = rho * v_i * v_y - B_i * B_y +
2284 ! delta_(y,i) * p_tot
2285 flux_rsx_vf(j, k, l, &
2286 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
2287 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
2288 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
2289 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
2290 end do
2291 else if (mhd .and. relativity) then
2292
2293# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2294#if defined(MFC_OpenACC)
2295# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2296!$acc loop seq
2297# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2298#elif defined(MFC_OpenMP)
2299# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2300
2301# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2302#endif
2303 do i = 1, 3
2304 ! Flux of m_i in the y direction = m_i * v_y - b_i/Gamma * B_y +
2305 ! delta_(y,i) * p_tot
2306 flux_rsx_vf(j, k, l, &
2307 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
2308 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
2309 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
2310 & ) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
2311 end do
2312 else if (bubbles_euler) then
2313
2314# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2315#if defined(MFC_OpenACC)
2316# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2317!$acc loop seq
2318# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2319#elif defined(MFC_OpenMP)
2320# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2321
2322# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2323#endif
2324 do i = 1, num_vels
2325 flux_rsx_vf(j, k, l, &
2326 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2327 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
2328 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
2329 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
2330 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
2331 end do
2332 else if (hypoelasticity) then
2333
2334# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2335#if defined(MFC_OpenACC)
2336# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2337!$acc loop seq
2338# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2339#elif defined(MFC_OpenMP)
2340# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2341
2342# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2343#endif
2344 do i = 1, num_vels
2345 flux_rsx_vf(j, k, l, &
2346 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2347 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
2348 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l &
2349 & - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
2350 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
2351 end do
2352 else
2353
2354# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2355#if defined(MFC_OpenACC)
2356# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2357!$acc loop seq
2358# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2359#elif defined(MFC_OpenMP)
2360# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2361
2362# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2363#endif
2364 do i = 1, num_vels
2365 flux_rsx_vf(j, k, l, &
2366 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2367 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
2368 & + dir_flg(dir_idx(i))*pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
2369 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
2370 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
2371 end do
2372 end if
2373
2374 ! Energy
2375 if (mhd .and. (.not. relativity)) then
2376 ! energy flux = (E + p + p_mag) * v_y - B_y * (v_x*B_x + v_y*B_y + v_z*B_z)
2377# 626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2378 flux_rsx_vf(j, k, l, &
2379 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
2380 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) - s_p*(vel_l(norm_dir) &
2381 & *(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) &
2382 & + vel_l(3)*b%L(3))) + s_m*s_p*(e_l - e_r))/(s_m - s_p)
2383# 632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2384 else if (mhd .and. relativity) then
2385 ! energy flux = m_y - mass flux Hard-coded for single-component for now
2386 flux_rsx_vf(j, k, l, &
2387 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
2388 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l - e_r)) &
2389 & /(s_m - s_p)
2390 else if (bubbles_euler) then
2391 flux_rsx_vf(j, k, l, &
2392 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) - s_p*vel_l(dir_idx(1) &
2393 & )*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
2394 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
2395 else if (hypoelasticity) then
2396 flux_tau_l = 0._wp; flux_tau_r = 0._wp
2397
2398# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2399#if defined(MFC_OpenACC)
2400# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2401!$acc loop seq
2402# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2403#elif defined(MFC_OpenMP)
2404# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2405
2406# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2407#endif
2408 do i = 1, num_dims
2409 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
2410 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
2411 end do
2412 flux_rsx_vf(j, k, l, &
2413 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
2414 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r))/(s_m &
2415 & - s_p)
2416 else
2417 flux_rsx_vf(j, k, l, &
2418 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
2419 & + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms &
2420 & - vel_l_rms)/2._wp
2421 end if
2422
2423 ! Elastic Stresses
2424 if (hypoelasticity) then
2425 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
2426 flux_rsx_vf(j, k, l, &
2427 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
2428 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
2429 & - rho_r*tau_e_r(i)))/(s_m - s_p)
2430 end do
2431 end if
2432
2433 ! Advection flux and source: interface velocity for volume fraction transport
2434
2435# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2436#if defined(MFC_OpenACC)
2437# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2438!$acc loop seq
2439# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2440#elif defined(MFC_OpenMP)
2441# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2442
2443# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2444#endif
2445 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2446 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j, k + 1, l, &
2447 & i))*s_m*s_p/(s_m - s_p)
2448 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j, k + 1, l, &
2449 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
2450 end do
2451
2452 if (bubbles_euler) then
2453 ! From HLLC: Kills mass transport @ bubble gas density
2454 if (num_fluids > 1) then
2455 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
2456 end if
2457 end if
2458
2459 if (chemistry) then
2460
2461# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2462#if defined(MFC_OpenACC)
2463# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2464!$acc loop seq
2465# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2466#elif defined(MFC_OpenMP)
2467# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2468
2469# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2470#endif
2471 do i = eqn_idx%species%beg, eqn_idx%species%end
2472 y_l = ql_prim_rsx_vf(j, k, l, i)
2473 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
2474
2475 flux_rsx_vf(j, k, l, &
2476 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
2477 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
2478 flux_src_rsx_vf(j, k, l, i) = 0._wp
2479 end do
2480 end if
2481
2482 ! MHD: magnetic flux and Maxwell stress contributions
2483 if (mhd) then
2484 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
2485 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
2486
2487# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2488#if defined(MFC_OpenACC)
2489# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2490!$acc loop seq
2491# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2492#elif defined(MFC_OpenMP)
2493# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2494
2495# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2496#endif
2497 do i = 0, 1
2498 flux_rsx_vf(j, k, l, &
2499 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
2500 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
2501 & - b%R(2 + i)))/(s_m - s_p)
2502 end do
2503 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
2504 ! B_x d/dy flux = (1 - delta(x,y)) * (v_y * B_x - v_x * B_y) B_y
2505 ! d/dy flux = (1 - delta(y,y)) * (v_y * B_y - v_y * B_y) B_z d/dy
2506 ! flux = (1 - delta(z,y)) * (v_y * B_z - v_z * B_y)
2507
2508# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2509#if defined(MFC_OpenACC)
2510# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2511!$acc loop seq
2512# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2513#elif defined(MFC_OpenMP)
2514# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2515
2516# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2517#endif
2518 do i = 0, 2
2519 flux_rsx_vf(j, k, l, &
2520 & eqn_idx%B%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1) &
2521 & *b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1) &
2522 & *b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
2523 end do
2524
2525 if (hyper_cleaning) then
2526 ! propagate magnetic field divergence as a wave
2527 flux_rsx_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = flux_rsx_vf(j, k, l, &
2528 & eqn_idx%B%beg + norm_dir - 1) + (s_m*qr_prim_rsx_vf(j, k + 1, l, &
2529 & eqn_idx%psi) - s_p*ql_prim_rsx_vf(j, k, l, eqn_idx%psi))/(s_m - s_p)
2530
2531 flux_rsx_vf(j, k, l, &
2532 & eqn_idx%psi) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) &
2533 & - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsx_vf(j, k, l, &
2534 & eqn_idx%psi) - qr_prim_rsx_vf(j, k + 1, l, eqn_idx%psi)))/(s_m - s_p)
2535 else
2536 ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
2537 flux_rsx_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = 0._wp
2538 end if
2539 end if
2540 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
2541 end if
2542
2543# 742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2544 if (cyl_coord) then
2545 ! Substituting the advective flux into the inviscid geometrical source flux
2546
2547# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2548#if defined(MFC_OpenACC)
2549# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2550!$acc loop seq
2551# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2552#elif defined(MFC_OpenMP)
2553# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2554
2555# 744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2556#endif
2557 do i = 1, eqn_idx%E
2558 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
2559 end do
2560 ! Recalculating the radial momentum geometric source flux
2561 flux_gsrc_rsx_vf(j, k, l, eqn_idx%cont%end + 2) = flux_rsx_vf(j, k, l, &
2562 & eqn_idx%cont%end + 2) - (s_m*pres_r - s_p*pres_l)/(s_m - s_p)
2563 ! Geometrical source of the void fraction(s) is zero
2564
2565# 752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2566#if defined(MFC_OpenACC)
2567# 752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2568!$acc loop seq
2569# 752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2570#elif defined(MFC_OpenMP)
2571# 752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2572
2573# 752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2574#endif
2575 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2576 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
2577 end do
2578 end if
2579
2580 if (cyl_coord .and. hypoelasticity) then
2581 ! += tau_sigmasigma using HLL
2582 flux_gsrc_rsx_vf(j, k, l, eqn_idx%cont%end + 2) = flux_gsrc_rsx_vf(j, k, l, &
2583 & eqn_idx%cont%end + 2) + (s_m*tau_e_r(4) - s_p*tau_e_l(4))/(s_m - s_p)
2584
2585
2586# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2587#if defined(MFC_OpenACC)
2588# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2589!$acc loop seq
2590# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2591#elif defined(MFC_OpenMP)
2592# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2593
2594# 763 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2595#endif
2596 do i = eqn_idx%stress%beg, eqn_idx%stress%end
2597 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
2598 end do
2599 end if
2600# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2601 end do
2602 end do
2603 end do
2604
2605# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2606#if defined(MFC_OpenACC)
2607# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2608!$acc end parallel loop
2609# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2610#elif defined(MFC_OpenMP)
2611# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2612
2613# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2614!$omp end target teams loop
2615# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2616#endif
2617 end if
2618# 207 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2619# 208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2620# 209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2621 if (norm_dir == 3) then
2622
2623# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2624
2625# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2626#if defined(MFC_OpenACC)
2627# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2628!$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)
2629# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2630#elif defined(MFC_OpenMP)
2631# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2632
2633# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2634
2635# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2636
2637# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2638!$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)
2639# 210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2640#endif
2641# 219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2642 do l = is1%beg, is1%end
2643 do k = is2%beg, is2%end
2644 do j = is3%beg, is3%end
2645
2646# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2647#if defined(MFC_OpenACC)
2648# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2649!$acc loop seq
2650# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2651#elif defined(MFC_OpenMP)
2652# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2653
2654# 222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2655#endif
2656 do i = 1, eqn_idx%cont%end
2657 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
2658 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
2659 end do
2660
2661 vel_l_rms = 0._wp; vel_r_rms = 0._wp
2662
2663
2664# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2665#if defined(MFC_OpenACC)
2666# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2667!$acc loop seq
2668# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2669#elif defined(MFC_OpenMP)
2670# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2671
2672# 230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2673#endif
2674 do i = 1, num_vels
2675 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
2676 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
2677 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
2678 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
2679 end do
2680
2681
2682# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2683#if defined(MFC_OpenACC)
2684# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2685!$acc loop seq
2686# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2687#elif defined(MFC_OpenMP)
2688# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2689
2690# 238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2691#endif
2692 do i = 1, num_fluids
2693 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2694 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
2695 end do
2696
2697 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
2698 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
2699
2700 if (mhd) then
2701 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
2702 b%L(1) = bx0
2703 b%R(1) = bx0
2704 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
2705 b%R(2) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg)
2706 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
2707 b%R(3) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + 1)
2708 else ! 2D/3D: Bx, By, Bz as variables
2709 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
2710 b%R(1) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg)
2711 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
2712 b%R(2) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + 1)
2713 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
2714 b%R(3) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + 2)
2715 end if
2716 end if
2717
2718 rho_l = 0._wp
2719 gamma_l = 0._wp
2720 pi_inf_l = 0._wp
2721 qv_l = 0._wp
2722
2723 rho_r = 0._wp
2724 gamma_r = 0._wp
2725 pi_inf_r = 0._wp
2726 qv_r = 0._wp
2727
2728 alpha_l_sum = 0._wp
2729 alpha_r_sum = 0._wp
2730
2731 pres_mag%L = 0._wp
2732 pres_mag%R = 0._wp
2733
2734 if (mpp_lim) then
2735
2736# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2737#if defined(MFC_OpenACC)
2738# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2739!$acc loop seq
2740# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2741#elif defined(MFC_OpenMP)
2742# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2743
2744# 282 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2745#endif
2746 do i = 1, num_fluids
2747 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
2748 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
2749 alpha_l_sum = alpha_l_sum + alpha_l(i)
2750 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
2751 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
2752 alpha_r_sum = alpha_r_sum + alpha_r(i)
2753 end do
2754
2755 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
2756 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
2757 end if
2758
2759
2760# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2761#if defined(MFC_OpenACC)
2762# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2763!$acc loop seq
2764# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2765#elif defined(MFC_OpenMP)
2766# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2767
2768# 296 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2769#endif
2770 do i = 1, num_fluids
2771 rho_l = rho_l + alpha_rho_l(i)
2772 gamma_l = gamma_l + alpha_l(i)*gammas(i)
2773 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
2774 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
2775
2776 rho_r = rho_r + alpha_rho_r(i)
2777 gamma_r = gamma_r + alpha_r(i)*gammas(i)
2778 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
2779 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
2780 end do
2781
2782 if (viscous) then
2783
2784# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2785#if defined(MFC_OpenACC)
2786# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2787!$acc loop seq
2788# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2789#elif defined(MFC_OpenMP)
2790# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2791
2792# 310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2793#endif
2794 do i = 1, 2
2795 re_l(i) = dflt_real
2796 re_r(i) = dflt_real
2797
2798 if (re_size(i) > 0) re_l(i) = 0._wp
2799 if (re_size(i) > 0) re_r(i) = 0._wp
2800
2801
2802# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2803#if defined(MFC_OpenACC)
2804# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2805!$acc loop seq
2806# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2807#elif defined(MFC_OpenMP)
2808# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2809
2810# 318 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2811#endif
2812 do q = 1, re_size(i)
2813 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
2814 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
2815 end do
2816
2817 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
2818 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
2819 end do
2820 end if
2821
2822 if (chemistry) then
2823
2824# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2825#if defined(MFC_OpenACC)
2826# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2827!$acc loop seq
2828# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2829#elif defined(MFC_OpenMP)
2830# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2831
2832# 330 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2833#endif
2834 do i = eqn_idx%species%beg, eqn_idx%species%end
2835 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
2836 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
2837 end do
2838
2839 call get_mixture_molecular_weight(ys_l, mw_l)
2840 call get_mixture_molecular_weight(ys_r, mw_r)
2841 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
2842 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
2843
2844 r_gas_l = gas_constant/mw_l
2845 r_gas_r = gas_constant/mw_r
2846 t_l = pres_l/rho_l/r_gas_l
2847 t_r = pres_r/rho_r/r_gas_r
2848
2849 call get_species_specific_heats_r(t_l, cp_il)
2850 call get_species_specific_heats_r(t_r, cp_ir)
2851
2852 if (chem_params%gamma_method == 1) then
2853 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
2854 gamma_il = cp_il/(cp_il - 1.0_wp)
2855 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
2856
2857 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
2858 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
2859 else if (chem_params%gamma_method == 2) then
2860 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
2861 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
2862 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
2863 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
2864 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
2865
2866 gamm_l = cp_l/cv_l
2867 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
2868 gamm_r = cp_r/cv_r
2869 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
2870 end if
2871
2872 call get_mixture_energy_mass(t_l, ys_l, e_l)
2873 call get_mixture_energy_mass(t_r, ys_r, e_r)
2874
2875 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
2876 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
2877 h_l = (e_l + pres_l)/rho_l
2878 h_r = (e_r + pres_r)/rho_r
2879 else if (mhd .and. relativity) then
2880 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
2881 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
2882# 380 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2883 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
2884 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
2885
2886 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
2887 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
2888 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
2889 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
2890# 388 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2891
2892 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
2893 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
2894
2895 ! Hard-coded EOS
2896 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
2897 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
2898# 396 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2899 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
2900 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
2901# 399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2902
2903 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
2904 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
2905 else if (mhd .and. .not. relativity) then
2906# 404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2907 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
2908 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
2909# 407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2910 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
2911 ! includes magnetic energy
2912 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R
2913 h_l = (e_l + pres_l - pres_mag%L)/rho_l
2914 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
2915 h_r = (e_r + pres_r - pres_mag%R)/rho_r
2916 else
2917 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
2918 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
2919 h_l = (e_l + pres_l)/rho_l
2920 h_r = (e_r + pres_r)/rho_r
2921 end if
2922
2923 ! elastic energy update
2924 if (hypoelasticity) then
2925 g_l = 0._wp; g_r = 0._wp
2926
2927
2928# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2929#if defined(MFC_OpenACC)
2930# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2931!$acc loop seq
2932# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2933#elif defined(MFC_OpenMP)
2934# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2935
2936# 424 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2937#endif
2938 do i = 1, num_fluids
2939 g_l = g_l + alpha_l(i)*gs_rs(i)
2940 g_r = g_r + alpha_r(i)*gs_rs(i)
2941 end do
2942
2943 if (cont_damage) then
2944 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
2945 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
2946 end if
2947
2948
2949# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2950#if defined(MFC_OpenACC)
2951# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2952!$acc loop seq
2953# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2954#elif defined(MFC_OpenMP)
2955# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2956
2957# 435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2958#endif
2959 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
2960 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
2961 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
2962 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
2963 if ((g_l > 1000) .and. (g_r > 1000)) then
2964 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2965 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2966 ! Double for shear stresses
2967 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
2968 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2969 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2970 end if
2971 end if
2972 end do
2973 end if
2974
2975 if (avg_state == 1) then
2976# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2977 rho_avg = sqrt(rho_l*rho_r)
2978# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2979
2980# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2981 vel_avg_rms = 0._wp
2982# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2983
2984# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2985
2986# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2987#if defined(MFC_OpenACC)
2988# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2989!$acc loop seq
2990# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2991#elif defined(MFC_OpenMP)
2992# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2993
2994# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2995#endif
2996# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2997 do i = 1, num_vels
2998# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2999 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
3000# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3001 end do
3002# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3003
3004# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3005 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
3006# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3007
3008# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3009 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
3010# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3011
3012# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3013 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
3014# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3015
3016# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3017 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
3018# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3019
3020# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3021 if (chemistry) then
3022# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3023 eps = 0.001_wp
3024# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3025 call get_species_enthalpies_rt(t_l, h_il)
3026# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3027 call get_species_enthalpies_rt(t_r, h_ir)
3028# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3029 h_il = h_il*gas_constant/molecular_weights*t_l
3030# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3031 h_ir = h_ir*gas_constant/molecular_weights*t_r
3032# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3033 call get_species_specific_heats_r(t_l, cp_il)
3034# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3035 call get_species_specific_heats_r(t_r, cp_ir)
3036# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3037
3038# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3039 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
3040# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3041 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
3042# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3043 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
3044# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3045 if (abs(t_l - t_r) < eps) then
3046# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3047 ! Case when T_L and T_R are very close
3048# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3049 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
3050# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3051 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
3052# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3053 & - gas_constant/molecular_weights(:)))
3054# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3055 else
3056# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3057 ! Normal calculation when T_L and T_R are sufficiently different
3058# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3059 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
3060# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3061 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
3062# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3063 end if
3064# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3065 gamma_avg = cp_avg/cv_avg
3066# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3067
3068# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3069 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
3070# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3071 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
3072# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3073 end if
3074# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3075 end if
3076# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3077
3078# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3079 if (avg_state == 2) then
3080# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3081 rho_avg = 5.e-1_wp*(rho_l + rho_r)
3082# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3083 vel_avg_rms = 0._wp
3084# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3085
3086# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3087#if defined(MFC_OpenACC)
3088# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3089!$acc loop seq
3090# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3091#elif defined(MFC_OpenMP)
3092# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3093
3094# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3095#endif
3096# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3097 do i = 1, num_vels
3098# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3099 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
3100# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3101 end do
3102# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3103
3104# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3105 h_avg = 5.e-1_wp*(h_l + h_r)
3106# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3107 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
3108# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3109 qv_avg = 5.e-1_wp*(qv_l + qv_r)
3110# 452 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3111 end if
3112
3113 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, &
3114 & qv_l)
3115
3116 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, &
3117 & qv_r)
3118
3119 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
3120 ! variables are placeholders to call the subroutine.
3121
3122 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
3123 & c_sum_yi_phi, c_avg, qv_avg)
3124
3125 if (mhd) then
3126 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
3127 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
3128 end if
3129
3130 if (viscous) then
3131 if (chemistry) then
3132 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
3133 end if
3134
3135# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3136#if defined(MFC_OpenACC)
3137# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3138!$acc loop seq
3139# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3140#elif defined(MFC_OpenMP)
3141# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3142
3143# 475 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3144#endif
3145 do i = 1, 2
3146 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3147 end do
3148 end if
3149
3150 ! Wave speed estimates (wave_speeds=1: direct, wave_speeds=2: pressure-based)
3151 if (wave_speeds == 1) then
3152 if (mhd) then
3153 ! MHD: use fast magnetosonic speed
3154 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
3155 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
3156 else if (hypoelasticity) then
3157 ! Elastic wave speed, Rodriguez et al. JCP (2019)
3158 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))) &
3159 & /rho_l), &
3160 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
3161 & /rho_r))
3162 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))) &
3163 & /rho_r), &
3164 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
3165 & /rho_l))
3166 else if (hyperelasticity) then
3167 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l), &
3168 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
3169 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r), &
3170 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
3171 else
3172 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3173 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3174 end if
3175
3176 if (hyper_cleaning) then
3177 ! Dedner GLM divergence cleaning, Dedner et al. JCP (2002)
3178 s_l = min(s_l, -hyper_cleaning_speed)
3179 s_r = max(s_r, hyper_cleaning_speed)
3180 end if
3181
3182 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
3183 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
3184 & - rho_r*(s_r - vel_r(dir_idx(1))))
3185 else if (wave_speeds == 2) then
3186 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3187
3188 pres_sr = pres_sl
3189
3190 ! Low Mach correction: Thornber et al. JCP (2008)
3191 ms_l = max(1._wp, &
3192 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
3193 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
3194 ms_r = max(1._wp, &
3195 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
3196 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
3197
3198 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3199 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3200
3201 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
3202 end if
3203
3204 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3205
3206 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, &
3207 & s_r))
3208 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, &
3209 & s_r))
3210
3211 ! 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
3212 if (low_mach == 1) then
3213 if (riemann_solver == 1 .or. riemann_solver == 5) then
3214# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3215 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3216# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3217 pcorr = 0._wp
3218# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3219
3220# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3221 if (low_mach == 1) then
3222# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3223 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3224# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3225 end if
3226# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3227 else if (riemann_solver == 2) then
3228# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3229 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3230# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3231 pcorr = 0._wp
3232# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3233
3234# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3235 if (low_mach == 1) then
3236# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3237 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))) &
3238# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3239 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3240# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3241 else if (low_mach == 2) then
3242# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3243 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))))
3244# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3245 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))))
3246# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3247 vel_l(dir_idx(1)) = vel_l_tmp
3248# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3249 vel_r(dir_idx(1)) = vel_r_tmp
3250# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3251 end if
3252# 544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3253 end if
3254 else
3255 pcorr = 0._wp
3256 end if
3257
3258 ! Mass
3259 if (.not. relativity) then
3260
3261# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3262#if defined(MFC_OpenACC)
3263# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3264!$acc loop seq
3265# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3266#elif defined(MFC_OpenMP)
3267# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3268
3269# 551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3270#endif
3271 do i = 1, eqn_idx%cont%end
3272 flux_rsx_vf(j, k, l, &
3273 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
3274 & + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
3275 end do
3276 else if (relativity) then
3277
3278# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3279#if defined(MFC_OpenACC)
3280# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3281!$acc loop seq
3282# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3283#elif defined(MFC_OpenMP)
3284# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3285
3286# 558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3287#endif
3288 do i = 1, eqn_idx%cont%end
3289 flux_rsx_vf(j, k, l, &
3290 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
3291 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i)))/(s_m &
3292 & - s_p)
3293 end do
3294 end if
3295
3296 ! Momentum
3297 if (mhd .and. (.not. relativity)) then
3298
3299# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3300#if defined(MFC_OpenACC)
3301# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3302!$acc loop seq
3303# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3304#elif defined(MFC_OpenMP)
3305# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3306
3307# 569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3308#endif
3309 do i = 1, 3
3310 ! Flux of rho*v_i in the z direction = rho * v_i * v_z - B_i * B_z +
3311 ! delta_(z,i) * p_tot
3312 flux_rsx_vf(j, k, l, &
3313 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
3314 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
3315 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
3316 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
3317 end do
3318 else if (mhd .and. relativity) then
3319
3320# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3321#if defined(MFC_OpenACC)
3322# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3323!$acc loop seq
3324# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3325#elif defined(MFC_OpenMP)
3326# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3327
3328# 580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3329#endif
3330 do i = 1, 3
3331 ! Flux of m_i in the z direction = m_i * v_z - b_i/Gamma * B_z +
3332 ! delta_(z,i) * p_tot
3333 flux_rsx_vf(j, k, l, &
3334 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
3335 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
3336 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
3337 & ) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
3338 end do
3339 else if (bubbles_euler) then
3340
3341# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3342#if defined(MFC_OpenACC)
3343# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3344!$acc loop seq
3345# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3346#elif defined(MFC_OpenMP)
3347# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3348
3349# 591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3350#endif
3351 do i = 1, num_vels
3352 flux_rsx_vf(j, k, l, &
3353 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
3354 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
3355 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
3356 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
3357 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
3358 end do
3359 else if (hypoelasticity) then
3360
3361# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3362#if defined(MFC_OpenACC)
3363# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3364!$acc loop seq
3365# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3366#elif defined(MFC_OpenMP)
3367# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3368
3369# 601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3370#endif
3371 do i = 1, num_vels
3372 flux_rsx_vf(j, k, l, &
3373 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
3374 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
3375 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l &
3376 & - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
3377 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
3378 end do
3379 else
3380
3381# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3382#if defined(MFC_OpenACC)
3383# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3384!$acc loop seq
3385# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3386#elif defined(MFC_OpenMP)
3387# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3388
3389# 611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3390#endif
3391 do i = 1, num_vels
3392 flux_rsx_vf(j, k, l, &
3393 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
3394 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
3395 & + dir_flg(dir_idx(i))*pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
3396 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
3397 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
3398 end do
3399 end if
3400
3401 ! Energy
3402 if (mhd .and. (.not. relativity)) then
3403 ! energy flux = (E + p + p_mag) * v_z - B_z * (v_x*B_x + v_y*B_y + v_z*B_z)
3404# 626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3405 flux_rsx_vf(j, k, l, &
3406 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
3407 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) - s_p*(vel_l(norm_dir) &
3408 & *(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) &
3409 & + vel_l(3)*b%L(3))) + s_m*s_p*(e_l - e_r))/(s_m - s_p)
3410# 632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3411 else if (mhd .and. relativity) then
3412 ! energy flux = m_z - mass flux Hard-coded for single-component for now
3413 flux_rsx_vf(j, k, l, &
3414 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
3415 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l - e_r)) &
3416 & /(s_m - s_p)
3417 else if (bubbles_euler) then
3418 flux_rsx_vf(j, k, l, &
3419 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) - s_p*vel_l(dir_idx(1) &
3420 & )*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
3421 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
3422 else if (hypoelasticity) then
3423 flux_tau_l = 0._wp; flux_tau_r = 0._wp
3424
3425# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3426#if defined(MFC_OpenACC)
3427# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3428!$acc loop seq
3429# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3430#elif defined(MFC_OpenMP)
3431# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3432
3433# 645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3434#endif
3435 do i = 1, num_dims
3436 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
3437 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
3438 end do
3439 flux_rsx_vf(j, k, l, &
3440 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
3441 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r))/(s_m &
3442 & - s_p)
3443 else
3444 flux_rsx_vf(j, k, l, &
3445 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
3446 & + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms &
3447 & - vel_l_rms)/2._wp
3448 end if
3449
3450 ! Elastic Stresses
3451 if (hypoelasticity) then
3452 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
3453 flux_rsx_vf(j, k, l, &
3454 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
3455 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
3456 & - rho_r*tau_e_r(i)))/(s_m - s_p)
3457 end do
3458 end if
3459
3460 ! Advection flux and source: interface velocity for volume fraction transport
3461
3462# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3463#if defined(MFC_OpenACC)
3464# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3465!$acc loop seq
3466# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3467#elif defined(MFC_OpenMP)
3468# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3469
3470# 672 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3471#endif
3472 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3473 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j, k, l + 1, &
3474 & i))*s_m*s_p/(s_m - s_p)
3475 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j, k, l + 1, &
3476 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
3477 end do
3478
3479 if (bubbles_euler) then
3480 ! From HLLC: Kills mass transport @ bubble gas density
3481 if (num_fluids > 1) then
3482 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
3483 end if
3484 end if
3485
3486 if (chemistry) then
3487
3488# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3489#if defined(MFC_OpenACC)
3490# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3491!$acc loop seq
3492# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3493#elif defined(MFC_OpenMP)
3494# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3495
3496# 688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3497#endif
3498 do i = eqn_idx%species%beg, eqn_idx%species%end
3499 y_l = ql_prim_rsx_vf(j, k, l, i)
3500 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
3501
3502 flux_rsx_vf(j, k, l, &
3503 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
3504 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
3505 flux_src_rsx_vf(j, k, l, i) = 0._wp
3506 end do
3507 end if
3508
3509 ! MHD: magnetic flux and Maxwell stress contributions
3510 if (mhd) then
3511 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
3512 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
3513
3514# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3515#if defined(MFC_OpenACC)
3516# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3517!$acc loop seq
3518# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3519#elif defined(MFC_OpenMP)
3520# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3521
3522# 704 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3523#endif
3524 do i = 0, 1
3525 flux_rsx_vf(j, k, l, &
3526 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
3527 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
3528 & - b%R(2 + i)))/(s_m - s_p)
3529 end do
3530 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
3531 ! B_x d/dz flux = (1 - delta(x,z)) * (v_z * B_x - v_x * B_z) B_y
3532 ! d/dz flux = (1 - delta(y,z)) * (v_z * B_y - v_y * B_z) B_z d/dz
3533 ! flux = (1 - delta(z,z)) * (v_z * B_z - v_z * B_z)
3534
3535# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3536#if defined(MFC_OpenACC)
3537# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3538!$acc loop seq
3539# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3540#elif defined(MFC_OpenMP)
3541# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3542
3543# 715 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3544#endif
3545 do i = 0, 2
3546 flux_rsx_vf(j, k, l, &
3547 & eqn_idx%B%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1) &
3548 & *b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1) &
3549 & *b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
3550 end do
3551
3552 if (hyper_cleaning) then
3553 ! propagate magnetic field divergence as a wave
3554 flux_rsx_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = flux_rsx_vf(j, k, l, &
3555 & eqn_idx%B%beg + norm_dir - 1) + (s_m*qr_prim_rsx_vf(j, k, l + 1, &
3556 & eqn_idx%psi) - s_p*ql_prim_rsx_vf(j, k, l, eqn_idx%psi))/(s_m - s_p)
3557
3558 flux_rsx_vf(j, k, l, &
3559 & eqn_idx%psi) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) &
3560 & - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsx_vf(j, k, l, &
3561 & eqn_idx%psi) - qr_prim_rsx_vf(j, k, l + 1, eqn_idx%psi)))/(s_m - s_p)
3562 else
3563 ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
3564 flux_rsx_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = 0._wp
3565 end if
3566 end if
3567 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
3568 end if
3569
3570# 769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3571 end do
3572 end do
3573 end do
3574
3575# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3576#if defined(MFC_OpenACC)
3577# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3578!$acc end parallel loop
3579# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3580#elif defined(MFC_OpenMP)
3581# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3582
3583# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3584!$omp end target teams loop
3585# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3586#endif
3587 end if
3588# 775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3589
3590 if (viscous) then
3591 if (weno_re_flux) then
3592 call s_compute_viscous_source_flux(ql_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3593 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3594 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3595 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3596 & qr_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3597 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3598 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3599 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, &
3600 & iy, iz)
3601 else
3602 call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3603 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3604 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3605 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3606 & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3607 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3608 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3609 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, &
3610 & iy, iz)
3611 end if
3612 end if
3613
3614 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
3615
3616 end subroutine s_hll_riemann_solver
3617
3618 !> Lax-Friedrichs (Rusanov) approximate Riemann solver
3619 subroutine s_lf_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, &
3620
3621 & dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, &
3622 & flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
3623
3624 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, qr_prim_rsx_vf
3625 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
3626 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
3627 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
3628 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
3629
3630 ! Intercell fluxes
3631 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
3632 real(wp) :: flux_tau_l, flux_tau_r
3633 integer, intent(in) :: norm_dir
3634 type(int_bounds_info), intent(in) :: ix, iy, iz
3635
3636# 831 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3637 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
3638 real(wp), dimension(num_vels) :: vel_l, vel_r
3639 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
3640 real(wp), dimension(num_species) :: ys_l, ys_r
3641 real(wp), dimension(num_species) :: cp_il, cp_ir, xs_l, xs_r, gamma_il, gamma_ir
3642 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
3643 !> Averaged velocity gradient tensor `d(vel_i)/d(coord_j)`.
3644 real(wp), dimension(num_dims, num_dims) :: vel_grad_l, vel_grad_r
3645# 840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3646 real(wp) :: rho_l, rho_r
3647 real(wp) :: pres_l, pres_r
3648 real(wp) :: e_l, e_r
3649 real(wp) :: h_l, h_r
3650 real(wp) :: cp_avg, cv_avg, t_avg, eps, c_sum_yi_phi
3651 real(wp) :: t_l, t_r
3652 real(wp) :: y_l, y_r
3653 real(wp) :: mw_l, mw_r
3654 real(wp) :: r_gas_l, r_gas_r
3655 real(wp) :: cp_l, cp_r
3656 real(wp) :: cv_l, cv_r
3657 real(wp) :: gamm_l, gamm_r
3658 real(wp) :: gamma_l, gamma_r
3659 real(wp) :: pi_inf_l, pi_inf_r
3660 real(wp) :: qv_l, qv_r
3661 real(wp) :: c_l, c_r
3662 real(wp), dimension(6) :: tau_e_l, tau_e_r
3663 real(wp) :: g_l, g_r
3664 real(wp), dimension(2) :: re_l, re_r
3665 real(wp), dimension(3) :: xi_field_l, xi_field_r
3666 real(wp) :: rho_avg
3667 real(wp) :: h_avg
3668 real(wp) :: gamma_avg
3669 real(wp) :: c_avg
3670 real(wp) :: s_l, s_r, s_m, s_p, s_s
3671 real(wp) :: xi_m, xi_p
3672 real(wp) :: ptilde_l, ptilde_r
3673 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
3674 real(wp) :: vel_l_tmp, vel_r_tmp
3675 real(wp) :: ms_l, ms_r, pres_sl, pres_sr
3676 real(wp) :: alpha_l_sum, alpha_r_sum
3677 real(wp) :: zcoef, pcorr !< low Mach number correction
3678 type(riemann_states) :: c_fast, pres_mag
3679 type(riemann_states_vec3) :: b
3680 type(riemann_states) :: ga !< Gamma (Lorentz factor)
3681 type(riemann_states) :: vdotb, b2
3682 type(riemann_states_vec3) :: b4 !< 4-magnetic field components (spatial: b4x, b4y, b4z)
3683 type(riemann_states_vec3) :: cm !< Conservative momentum variables
3684 integer :: i, j, k, l, q !< Generic loop iterators
3685 integer, dimension(3) :: idx_right_phys !< Physical (j,k,l) indices for right state.
3686 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
3687
3688 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
3689 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
3690
3691 ! Reshaping inputted data based on dimensional splitting direction
3692 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
3693# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3694# 892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3695# 893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3696 if (norm_dir == 1) then
3697
3698# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3699
3700# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3701#if defined(MFC_OpenACC)
3702# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3703!$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)
3704# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3705#elif defined(MFC_OpenMP)
3706# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3707
3708# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3709
3710# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3711
3712# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3713!$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)
3714# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3715#endif
3716# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3717 do l = is3%beg, is3%end
3718 do k = is2%beg, is2%end
3719 do j = is1%beg, is1%end
3720
3721# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3722#if defined(MFC_OpenACC)
3723# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3724!$acc loop seq
3725# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3726#elif defined(MFC_OpenMP)
3727# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3728
3729# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3730#endif
3731 do i = 1, eqn_idx%cont%end
3732 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
3733 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
3734 end do
3735
3736 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3737
3738
3739# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3740#if defined(MFC_OpenACC)
3741# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3742!$acc loop seq
3743# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3744#elif defined(MFC_OpenMP)
3745# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3746
3747# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3748#endif
3749 do i = 1, num_vels
3750 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
3751 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
3752 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3753 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3754 end do
3755
3756
3757# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3758#if defined(MFC_OpenACC)
3759# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3760!$acc loop seq
3761# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3762#elif defined(MFC_OpenMP)
3763# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3764
3765# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3766#endif
3767 do i = 1, num_fluids
3768 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3769 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
3770 end do
3771
3772 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
3773 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
3774
3775 if (mhd) then
3776 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
3777 b%L(1) = bx0
3778 b%R(1) = bx0
3779 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
3780 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg)
3781 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
3782 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 1)
3783 else ! 2D/3D: Bx, By, Bz as variables
3784 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
3785 b%R(1) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg)
3786 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
3787 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 1)
3788 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
3789 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 2)
3790 end if
3791 end if
3792
3793 rho_l = 0._wp
3794 gamma_l = 0._wp
3795 pi_inf_l = 0._wp
3796 qv_l = 0._wp
3797
3798 rho_r = 0._wp
3799 gamma_r = 0._wp
3800 pi_inf_r = 0._wp
3801 qv_r = 0._wp
3802
3803 alpha_l_sum = 0._wp
3804 alpha_r_sum = 0._wp
3805
3806 pres_mag%L = 0._wp
3807 pres_mag%R = 0._wp
3808
3809 if (mpp_lim) then
3810
3811# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3812#if defined(MFC_OpenACC)
3813# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3814!$acc loop seq
3815# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3816#elif defined(MFC_OpenMP)
3817# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3818
3819# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3820#endif
3821 do i = 1, num_fluids
3822 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
3823 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
3824 alpha_l_sum = alpha_l_sum + alpha_l(i)
3825 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
3826 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
3827 alpha_r_sum = alpha_r_sum + alpha_r(i)
3828 end do
3829
3830 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
3831 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
3832 end if
3833
3834
3835# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3836#if defined(MFC_OpenACC)
3837# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3838!$acc loop seq
3839# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3840#elif defined(MFC_OpenMP)
3841# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3842
3843# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3844#endif
3845 do i = 1, num_fluids
3846 rho_l = rho_l + alpha_rho_l(i)
3847 gamma_l = gamma_l + alpha_l(i)*gammas(i)
3848 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
3849 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
3850
3851 rho_r = rho_r + alpha_rho_r(i)
3852 gamma_r = gamma_r + alpha_r(i)*gammas(i)
3853 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
3854 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
3855 end do
3856
3857 if (viscous) then
3858
3859# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3860#if defined(MFC_OpenACC)
3861# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3862!$acc loop seq
3863# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3864#elif defined(MFC_OpenMP)
3865# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3866
3867# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3868#endif
3869 do i = 1, 2
3870 re_l(i) = dflt_real
3871 re_r(i) = dflt_real
3872
3873 if (re_size(i) > 0) re_l(i) = 0._wp
3874 if (re_size(i) > 0) re_r(i) = 0._wp
3875
3876
3877# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3878#if defined(MFC_OpenACC)
3879# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3880!$acc loop seq
3881# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3882#elif defined(MFC_OpenMP)
3883# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3884
3885# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3886#endif
3887 do q = 1, re_size(i)
3888 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
3889 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
3890 end do
3891
3892 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
3893 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
3894 end do
3895 end if
3896
3897 if (chemistry) then
3898
3899# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3900#if defined(MFC_OpenACC)
3901# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3902!$acc loop seq
3903# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3904#elif defined(MFC_OpenMP)
3905# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3906
3907# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3908#endif
3909 do i = eqn_idx%species%beg, eqn_idx%species%end
3910 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
3911 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
3912 end do
3913
3914 call get_mixture_molecular_weight(ys_l, mw_l)
3915 call get_mixture_molecular_weight(ys_r, mw_r)
3916
3917 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
3918 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
3919
3920 r_gas_l = gas_constant/mw_l
3921 r_gas_r = gas_constant/mw_r
3922 t_l = pres_l/rho_l/r_gas_l
3923 t_r = pres_r/rho_r/r_gas_r
3924
3925 call get_species_specific_heats_r(t_l, cp_il)
3926 call get_species_specific_heats_r(t_r, cp_ir)
3927
3928 if (chem_params%gamma_method == 1) then
3929 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
3930 gamma_il = cp_il/(cp_il - 1.0_wp)
3931 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
3932
3933 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
3934 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
3935 else if (chem_params%gamma_method == 2) then
3936 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
3937 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
3938 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
3939 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
3940 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
3941
3942 gamm_l = cp_l/cv_l
3943 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
3944 gamm_r = cp_r/cv_r
3945 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
3946 end if
3947
3948 call get_mixture_energy_mass(t_l, ys_l, e_l)
3949 call get_mixture_energy_mass(t_r, ys_r, e_r)
3950
3951 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
3952 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
3953 h_l = (e_l + pres_l)/rho_l
3954 h_r = (e_r + pres_r)/rho_r
3955 else if (mhd .and. relativity) then
3956# 1063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3957 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
3958 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
3959 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
3960 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
3961
3962 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
3963 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
3964 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
3965 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
3966
3967 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
3968 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
3969
3970 ! Hard-coded EOS
3971 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
3972 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
3973
3974 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
3975 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
3976
3977 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
3978 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
3979# 1086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3980 else if (mhd .and. .not. relativity) then
3981 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
3982 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
3983 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
3984 ! includes magnetic energy
3985 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R
3986 h_l = (e_l + pres_l - pres_mag%L)/rho_l
3987 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
3988 h_r = (e_r + pres_r - pres_mag%R)/rho_r
3989 else
3990 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
3991 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
3992 h_l = (e_l + pres_l)/rho_l
3993 h_r = (e_r + pres_r)/rho_r
3994 end if
3995
3996 ! elastic energy update
3997 if (hypoelasticity) then
3998 g_l = 0._wp; g_r = 0._wp
3999
4000
4001# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4002#if defined(MFC_OpenACC)
4003# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4004!$acc loop seq
4005# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4006#elif defined(MFC_OpenMP)
4007# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4008
4009# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4010#endif
4011 do i = 1, num_fluids
4012 g_l = g_l + alpha_l(i)*gs_rs(i)
4013 g_r = g_r + alpha_r(i)*gs_rs(i)
4014 end do
4015
4016 if (cont_damage) then
4017 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
4018 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
4019 end if
4020
4021 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4022 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
4023 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
4024 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
4025 if ((g_l > 1000) .and. (g_r > 1000)) then
4026 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4027 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4028 ! Double for shear stresses
4029 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
4030 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4031 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4032 end if
4033 end if
4034 end do
4035 end if
4036
4037 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, &
4038 & qv_l)
4039
4040 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, &
4041 & qv_r)
4042
4043 if (mhd) then
4044 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
4045 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
4046 end if
4047
4048 s_l = 0._wp; s_r = 0._wp
4049
4050
4051# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4052#if defined(MFC_OpenACC)
4053# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4054!$acc loop seq
4055# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4056#elif defined(MFC_OpenMP)
4057# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4058
4059# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4060#endif
4061 do i = 1, num_dims
4062 s_l = s_l + vel_l(i)**2._wp
4063 s_r = s_r + vel_r(i)**2._wp
4064 end do
4065
4066 s_l = sqrt(s_l)
4067 s_r = sqrt(s_r)
4068
4069 s_p = max(s_l, s_r) + max(c_l, c_r)
4070 s_m = -s_p
4071
4072 s_l = s_m
4073 s_r = s_p
4074
4075 ! Low Mach correction
4076 if (low_mach == 1) then
4077 if (riemann_solver == 1 .or. riemann_solver == 5) then
4078# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4079 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4080# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4081 pcorr = 0._wp
4082# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4083
4084# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4085 if (low_mach == 1) then
4086# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4087 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4088# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4089 end if
4090# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4091 else if (riemann_solver == 2) then
4092# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4093 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4094# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4095 pcorr = 0._wp
4096# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4097
4098# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4099 if (low_mach == 1) then
4100# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4101 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))) &
4102# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4103 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
4104# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4105 else if (low_mach == 2) then
4106# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4107 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))))
4108# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4109 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))))
4110# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4111 vel_l(dir_idx(1)) = vel_l_tmp
4112# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4113 vel_r(dir_idx(1)) = vel_r_tmp
4114# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4115 end if
4116# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4117 end if
4118 else
4119 pcorr = 0._wp
4120 end if
4121
4122 ! Mass
4123 if (.not. relativity) then
4124
4125# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4126#if defined(MFC_OpenACC)
4127# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4128!$acc loop seq
4129# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4130#elif defined(MFC_OpenMP)
4131# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4132
4133# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4134#endif
4135 do i = 1, eqn_idx%cont%end
4136 flux_rsx_vf(j, k, l, &
4137 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
4138 & + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
4139 end do
4140 else if (relativity) then
4141
4142# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4143#if defined(MFC_OpenACC)
4144# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4145!$acc loop seq
4146# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4147#elif defined(MFC_OpenMP)
4148# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4149
4150# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4151#endif
4152 do i = 1, eqn_idx%cont%end
4153 flux_rsx_vf(j, k, l, &
4154 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
4155 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i)))/(s_m &
4156 & - s_p)
4157 end do
4158 end if
4159
4160 ! Momentum
4161 if (mhd .and. (.not. relativity)) then
4162
4163# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4164#if defined(MFC_OpenACC)
4165# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4166!$acc loop seq
4167# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4168#elif defined(MFC_OpenMP)
4169# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4170
4171# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4172#endif
4173 do i = 1, 3
4174 ! Flux of rho*v_i in the x direction = rho * v_i * v_x - B_i * B_x +
4175 ! delta_(x,i) * p_tot
4176 flux_rsx_vf(j, k, l, &
4177 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
4178 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
4179 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
4180 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
4181 end do
4182 else if (mhd .and. relativity) then
4183
4184# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4185#if defined(MFC_OpenACC)
4186# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4187!$acc loop seq
4188# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4189#elif defined(MFC_OpenMP)
4190# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4191
4192# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4193#endif
4194 do i = 1, 3
4195 ! Flux of m_i in the x direction = m_i * v_x - b_i/Gamma * B_x +
4196 ! delta_(x,i) * p_tot
4197 flux_rsx_vf(j, k, l, &
4198 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
4199 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
4200 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
4201 & ) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
4202 end do
4203 else if (bubbles_euler) then
4204
4205# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4206#if defined(MFC_OpenACC)
4207# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4208!$acc loop seq
4209# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4210#elif defined(MFC_OpenMP)
4211# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4212
4213# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4214#endif
4215 do i = 1, num_vels
4216 flux_rsx_vf(j, k, l, &
4217 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4218 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
4219 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
4220 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
4221 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4222 end do
4223 else if (hypoelasticity) then
4224
4225# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4226#if defined(MFC_OpenACC)
4227# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4228!$acc loop seq
4229# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4230#elif defined(MFC_OpenMP)
4231# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4232
4233# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4234#endif
4235 do i = 1, num_vels
4236 flux_rsx_vf(j, k, l, &
4237 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4238 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
4239 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l &
4240 & - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4241 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
4242 end do
4243 else
4244
4245# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4246#if defined(MFC_OpenACC)
4247# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4248!$acc loop seq
4249# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4250#elif defined(MFC_OpenMP)
4251# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4252
4253# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4254#endif
4255 do i = 1, num_vels
4256 flux_rsx_vf(j, k, l, &
4257 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4258 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
4259 & + dir_flg(dir_idx(i))*pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4260 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
4261 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4262 end do
4263 end if
4264
4265 ! Energy
4266 if (mhd .and. (.not. relativity)) then
4267 ! energy flux = (E + p + p_mag) * v_x - B_x * (v_x*B_x + v_y*B_y + v_z*B_z)
4268# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4269 flux_rsx_vf(j, k, l, &
4270 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
4271 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) - s_p*(vel_l(norm_dir) &
4272 & *(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) &
4273 & + vel_l(3)*b%L(3))) + s_m*s_p*(e_l - e_r))/(s_m - s_p)
4274# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4275 else if (mhd .and. relativity) then
4276 ! energy flux = m_x - mass flux Hard-coded for single-component for now
4277 flux_rsx_vf(j, k, l, &
4278 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
4279 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l - e_r)) &
4280 & /(s_m - s_p)
4281 else if (bubbles_euler) then
4282 flux_rsx_vf(j, k, l, &
4283 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) - s_p*vel_l(dir_idx(1) &
4284 & )*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
4285 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
4286 else if (hypoelasticity) then
4287 flux_tau_l = 0._wp; flux_tau_r = 0._wp
4288
4289# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4290#if defined(MFC_OpenACC)
4291# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4292!$acc loop seq
4293# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4294#elif defined(MFC_OpenMP)
4295# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4296
4297# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4298#endif
4299 do i = 1, num_dims
4300 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
4301 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
4302 end do
4303 flux_rsx_vf(j, k, l, &
4304 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
4305 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r))/(s_m &
4306 & - s_p)
4307 else
4308 flux_rsx_vf(j, k, l, &
4309 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
4310 & + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms &
4311 & - vel_l_rms)/2._wp
4312 end if
4313
4314 ! Elastic Stresses
4315 if (hypoelasticity) then
4316 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
4317 flux_rsx_vf(j, k, l, &
4318 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
4319 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
4320 & - rho_r*tau_e_r(i)))/(s_m - s_p)
4321 end do
4322 end if
4323
4324 ! Advection flux and source: interface velocity for volume fraction transport
4325
4326# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4327#if defined(MFC_OpenACC)
4328# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4329!$acc loop seq
4330# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4331#elif defined(MFC_OpenMP)
4332# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4333
4334# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4335#endif
4336 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4337 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j + 1, k, l, &
4338 & i))*s_m*s_p/(s_m - s_p)
4339 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j + 1, k, l, &
4340 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
4341 end do
4342
4343 if (bubbles_euler) then
4344 ! From HLLC: Kills mass transport @ bubble gas density
4345 if (num_fluids > 1) then
4346 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
4347 end if
4348 end if
4349
4350 if (chemistry) then
4351
4352# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4353#if defined(MFC_OpenACC)
4354# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4355!$acc loop seq
4356# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4357#elif defined(MFC_OpenMP)
4358# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4359
4360# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4361#endif
4362 do i = eqn_idx%species%beg, eqn_idx%species%end
4363 y_l = ql_prim_rsx_vf(j, k, l, i)
4364 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
4365
4366 flux_rsx_vf(j, k, l, &
4367 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
4368 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
4369 flux_src_rsx_vf(j, k, l, i) = 0._wp
4370 end do
4371 end if
4372
4373 ! MHD: magnetic flux and Maxwell stress contributions
4374 if (mhd) then
4375 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
4376 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
4377
4378# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4379#if defined(MFC_OpenACC)
4380# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4381!$acc loop seq
4382# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4383#elif defined(MFC_OpenMP)
4384# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4385
4386# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4387#endif
4388 do i = 0, 1
4389 flux_rsx_vf(j, k, l, &
4390 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
4391 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
4392 & - b%R(2 + i)))/(s_m - s_p)
4393 end do
4394 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
4395 ! B_x d/dx flux = (1 - delta(x,x)) * (v_x * B_x - v_x * B_x) B_y
4396 ! d/dx flux = (1 - delta(y,x)) * (v_x * B_y - v_y * B_x) B_z d/dx
4397 ! flux = (1 - delta(z,x)) * (v_x * B_z - v_z * B_x)
4398
4399# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4400#if defined(MFC_OpenACC)
4401# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4402!$acc loop seq
4403# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4404#elif defined(MFC_OpenMP)
4405# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4406
4407# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4408#endif
4409 do i = 0, 2
4410 flux_rsx_vf(j, k, l, &
4411 & eqn_idx%B%beg + i) = (1 - dir_flg(i + 1))*(s_m*(vel_r(dir_idx(1))*b%R(i + 1) &
4412 & - vel_r(i + 1)*b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i &
4413 & + 1)*b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
4414 end do
4415 end if
4416 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
4417 end if
4418
4419# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4420 end do
4421 end do
4422 end do
4423
4424# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4425#if defined(MFC_OpenACC)
4426# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4427!$acc end parallel loop
4428# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4429#elif defined(MFC_OpenMP)
4430# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4431
4432# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4433!$omp end target teams loop
4434# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4435#endif
4436 end if
4437# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4438# 892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4439# 893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4440 if (norm_dir == 2) then
4441
4442# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4443
4444# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4445#if defined(MFC_OpenACC)
4446# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4447!$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)
4448# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4449#elif defined(MFC_OpenMP)
4450# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4451
4452# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4453
4454# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4455
4456# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4457!$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)
4458# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4459#endif
4460# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4461 do l = is3%beg, is3%end
4462 do k = is1%beg, is1%end
4463 do j = is2%beg, is2%end
4464
4465# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4466#if defined(MFC_OpenACC)
4467# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4468!$acc loop seq
4469# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4470#elif defined(MFC_OpenMP)
4471# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4472
4473# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4474#endif
4475 do i = 1, eqn_idx%cont%end
4476 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
4477 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
4478 end do
4479
4480 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4481
4482
4483# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4484#if defined(MFC_OpenACC)
4485# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4486!$acc loop seq
4487# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4488#elif defined(MFC_OpenMP)
4489# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4490
4491# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4492#endif
4493 do i = 1, num_vels
4494 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
4495 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
4496 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4497 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4498 end do
4499
4500
4501# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4502#if defined(MFC_OpenACC)
4503# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4504!$acc loop seq
4505# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4506#elif defined(MFC_OpenMP)
4507# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4508
4509# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4510#endif
4511 do i = 1, num_fluids
4512 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4513 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4514 end do
4515
4516 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
4517 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
4518
4519 if (mhd) then
4520 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
4521 b%L(1) = bx0
4522 b%R(1) = bx0
4523 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
4524 b%R(2) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg)
4525 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
4526 b%R(3) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + 1)
4527 else ! 2D/3D: Bx, By, Bz as variables
4528 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
4529 b%R(1) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg)
4530 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
4531 b%R(2) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + 1)
4532 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
4533 b%R(3) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + 2)
4534 end if
4535 end if
4536
4537 rho_l = 0._wp
4538 gamma_l = 0._wp
4539 pi_inf_l = 0._wp
4540 qv_l = 0._wp
4541
4542 rho_r = 0._wp
4543 gamma_r = 0._wp
4544 pi_inf_r = 0._wp
4545 qv_r = 0._wp
4546
4547 alpha_l_sum = 0._wp
4548 alpha_r_sum = 0._wp
4549
4550 pres_mag%L = 0._wp
4551 pres_mag%R = 0._wp
4552
4553 if (mpp_lim) then
4554
4555# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4556#if defined(MFC_OpenACC)
4557# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4558!$acc loop seq
4559# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4560#elif defined(MFC_OpenMP)
4561# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4562
4563# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4564#endif
4565 do i = 1, num_fluids
4566 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
4567 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
4568 alpha_l_sum = alpha_l_sum + alpha_l(i)
4569 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
4570 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
4571 alpha_r_sum = alpha_r_sum + alpha_r(i)
4572 end do
4573
4574 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
4575 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
4576 end if
4577
4578
4579# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4580#if defined(MFC_OpenACC)
4581# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4582!$acc loop seq
4583# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4584#elif defined(MFC_OpenMP)
4585# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4586
4587# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4588#endif
4589 do i = 1, num_fluids
4590 rho_l = rho_l + alpha_rho_l(i)
4591 gamma_l = gamma_l + alpha_l(i)*gammas(i)
4592 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
4593 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
4594
4595 rho_r = rho_r + alpha_rho_r(i)
4596 gamma_r = gamma_r + alpha_r(i)*gammas(i)
4597 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
4598 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
4599 end do
4600
4601 if (viscous) then
4602
4603# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4604#if defined(MFC_OpenACC)
4605# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4606!$acc loop seq
4607# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4608#elif defined(MFC_OpenMP)
4609# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4610
4611# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4612#endif
4613 do i = 1, 2
4614 re_l(i) = dflt_real
4615 re_r(i) = dflt_real
4616
4617 if (re_size(i) > 0) re_l(i) = 0._wp
4618 if (re_size(i) > 0) re_r(i) = 0._wp
4619
4620
4621# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4622#if defined(MFC_OpenACC)
4623# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4624!$acc loop seq
4625# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4626#elif defined(MFC_OpenMP)
4627# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4628
4629# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4630#endif
4631 do q = 1, re_size(i)
4632 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
4633 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
4634 end do
4635
4636 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
4637 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
4638 end do
4639 end if
4640
4641 if (chemistry) then
4642
4643# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4644#if defined(MFC_OpenACC)
4645# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4646!$acc loop seq
4647# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4648#elif defined(MFC_OpenMP)
4649# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4650
4651# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4652#endif
4653 do i = eqn_idx%species%beg, eqn_idx%species%end
4654 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
4655 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
4656 end do
4657
4658 call get_mixture_molecular_weight(ys_l, mw_l)
4659 call get_mixture_molecular_weight(ys_r, mw_r)
4660
4661 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
4662 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
4663
4664 r_gas_l = gas_constant/mw_l
4665 r_gas_r = gas_constant/mw_r
4666 t_l = pres_l/rho_l/r_gas_l
4667 t_r = pres_r/rho_r/r_gas_r
4668
4669 call get_species_specific_heats_r(t_l, cp_il)
4670 call get_species_specific_heats_r(t_r, cp_ir)
4671
4672 if (chem_params%gamma_method == 1) then
4673 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
4674 gamma_il = cp_il/(cp_il - 1.0_wp)
4675 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
4676
4677 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
4678 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
4679 else if (chem_params%gamma_method == 2) then
4680 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
4681 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
4682 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
4683 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
4684 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
4685
4686 gamm_l = cp_l/cv_l
4687 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
4688 gamm_r = cp_r/cv_r
4689 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
4690 end if
4691
4692 call get_mixture_energy_mass(t_l, ys_l, e_l)
4693 call get_mixture_energy_mass(t_r, ys_r, e_r)
4694
4695 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
4696 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
4697 h_l = (e_l + pres_l)/rho_l
4698 h_r = (e_r + pres_r)/rho_r
4699 else if (mhd .and. relativity) then
4700# 1063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4701 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
4702 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
4703 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
4704 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
4705
4706 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
4707 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
4708 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
4709 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
4710
4711 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
4712 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
4713
4714 ! Hard-coded EOS
4715 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
4716 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
4717
4718 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
4719 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
4720
4721 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
4722 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
4723# 1086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4724 else if (mhd .and. .not. relativity) then
4725 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
4726 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
4727 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
4728 ! includes magnetic energy
4729 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R
4730 h_l = (e_l + pres_l - pres_mag%L)/rho_l
4731 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
4732 h_r = (e_r + pres_r - pres_mag%R)/rho_r
4733 else
4734 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
4735 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
4736 h_l = (e_l + pres_l)/rho_l
4737 h_r = (e_r + pres_r)/rho_r
4738 end if
4739
4740 ! elastic energy update
4741 if (hypoelasticity) then
4742 g_l = 0._wp; g_r = 0._wp
4743
4744
4745# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4746#if defined(MFC_OpenACC)
4747# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4748!$acc loop seq
4749# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4750#elif defined(MFC_OpenMP)
4751# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4752
4753# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4754#endif
4755 do i = 1, num_fluids
4756 g_l = g_l + alpha_l(i)*gs_rs(i)
4757 g_r = g_r + alpha_r(i)*gs_rs(i)
4758 end do
4759
4760 if (cont_damage) then
4761 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
4762 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
4763 end if
4764
4765 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4766 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
4767 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
4768 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
4769 if ((g_l > 1000) .and. (g_r > 1000)) then
4770 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4771 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4772 ! Double for shear stresses
4773 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
4774 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4775 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4776 end if
4777 end if
4778 end do
4779 end if
4780
4781 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, &
4782 & qv_l)
4783
4784 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, &
4785 & qv_r)
4786
4787 if (mhd) then
4788 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
4789 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
4790 end if
4791
4792 s_l = 0._wp; s_r = 0._wp
4793
4794
4795# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4796#if defined(MFC_OpenACC)
4797# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4798!$acc loop seq
4799# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4800#elif defined(MFC_OpenMP)
4801# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4802
4803# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4804#endif
4805 do i = 1, num_dims
4806 s_l = s_l + vel_l(i)**2._wp
4807 s_r = s_r + vel_r(i)**2._wp
4808 end do
4809
4810 s_l = sqrt(s_l)
4811 s_r = sqrt(s_r)
4812
4813 s_p = max(s_l, s_r) + max(c_l, c_r)
4814 s_m = -s_p
4815
4816 s_l = s_m
4817 s_r = s_p
4818
4819 ! Low Mach correction
4820 if (low_mach == 1) then
4821 if (riemann_solver == 1 .or. riemann_solver == 5) then
4822# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4823 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4824# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4825 pcorr = 0._wp
4826# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4827
4828# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4829 if (low_mach == 1) then
4830# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4831 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4832# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4833 end if
4834# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4835 else if (riemann_solver == 2) then
4836# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4837 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4838# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4839 pcorr = 0._wp
4840# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4841
4842# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4843 if (low_mach == 1) then
4844# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4845 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))) &
4846# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4847 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
4848# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4849 else if (low_mach == 2) then
4850# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4851 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))))
4852# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4853 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))))
4854# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4855 vel_l(dir_idx(1)) = vel_l_tmp
4856# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4857 vel_r(dir_idx(1)) = vel_r_tmp
4858# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4859 end if
4860# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4861 end if
4862 else
4863 pcorr = 0._wp
4864 end if
4865
4866 ! Mass
4867 if (.not. relativity) then
4868
4869# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4870#if defined(MFC_OpenACC)
4871# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4872!$acc loop seq
4873# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4874#elif defined(MFC_OpenMP)
4875# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4876
4877# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4878#endif
4879 do i = 1, eqn_idx%cont%end
4880 flux_rsx_vf(j, k, l, &
4881 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
4882 & + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
4883 end do
4884 else if (relativity) then
4885
4886# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4887#if defined(MFC_OpenACC)
4888# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4889!$acc loop seq
4890# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4891#elif defined(MFC_OpenMP)
4892# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4893
4894# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4895#endif
4896 do i = 1, eqn_idx%cont%end
4897 flux_rsx_vf(j, k, l, &
4898 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
4899 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i)))/(s_m &
4900 & - s_p)
4901 end do
4902 end if
4903
4904 ! Momentum
4905 if (mhd .and. (.not. relativity)) then
4906
4907# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4908#if defined(MFC_OpenACC)
4909# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4910!$acc loop seq
4911# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4912#elif defined(MFC_OpenMP)
4913# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4914
4915# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4916#endif
4917 do i = 1, 3
4918 ! Flux of rho*v_i in the y direction = rho * v_i * v_y - B_i * B_y +
4919 ! delta_(y,i) * p_tot
4920 flux_rsx_vf(j, k, l, &
4921 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
4922 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
4923 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
4924 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
4925 end do
4926 else if (mhd .and. relativity) then
4927
4928# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4929#if defined(MFC_OpenACC)
4930# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4931!$acc loop seq
4932# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4933#elif defined(MFC_OpenMP)
4934# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4935
4936# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4937#endif
4938 do i = 1, 3
4939 ! Flux of m_i in the y direction = m_i * v_y - b_i/Gamma * B_y +
4940 ! delta_(y,i) * p_tot
4941 flux_rsx_vf(j, k, l, &
4942 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
4943 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
4944 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
4945 & ) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
4946 end do
4947 else if (bubbles_euler) then
4948
4949# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4950#if defined(MFC_OpenACC)
4951# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4952!$acc loop seq
4953# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4954#elif defined(MFC_OpenMP)
4955# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4956
4957# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4958#endif
4959 do i = 1, num_vels
4960 flux_rsx_vf(j, k, l, &
4961 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4962 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
4963 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
4964 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
4965 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4966 end do
4967 else if (hypoelasticity) then
4968
4969# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4970#if defined(MFC_OpenACC)
4971# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4972!$acc loop seq
4973# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4974#elif defined(MFC_OpenMP)
4975# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4976
4977# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4978#endif
4979 do i = 1, num_vels
4980 flux_rsx_vf(j, k, l, &
4981 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4982 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
4983 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l &
4984 & - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4985 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
4986 end do
4987 else
4988
4989# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4990#if defined(MFC_OpenACC)
4991# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4992!$acc loop seq
4993# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4994#elif defined(MFC_OpenMP)
4995# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4996
4997# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4998#endif
4999 do i = 1, num_vels
5000 flux_rsx_vf(j, k, l, &
5001 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5002 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
5003 & + dir_flg(dir_idx(i))*pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5004 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
5005 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5006 end do
5007 end if
5008
5009 ! Energy
5010 if (mhd .and. (.not. relativity)) then
5011 ! energy flux = (E + p + p_mag) * v_y - B_y * (v_x*B_x + v_y*B_y + v_z*B_z)
5012# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5013 flux_rsx_vf(j, k, l, &
5014 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
5015 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) - s_p*(vel_l(norm_dir) &
5016 & *(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) &
5017 & + vel_l(3)*b%L(3))) + s_m*s_p*(e_l - e_r))/(s_m - s_p)
5018# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5019 else if (mhd .and. relativity) then
5020 ! energy flux = m_y - mass flux Hard-coded for single-component for now
5021 flux_rsx_vf(j, k, l, &
5022 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
5023 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l - e_r)) &
5024 & /(s_m - s_p)
5025 else if (bubbles_euler) then
5026 flux_rsx_vf(j, k, l, &
5027 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) - s_p*vel_l(dir_idx(1) &
5028 & )*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
5029 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
5030 else if (hypoelasticity) then
5031 flux_tau_l = 0._wp; flux_tau_r = 0._wp
5032
5033# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5034#if defined(MFC_OpenACC)
5035# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5036!$acc loop seq
5037# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5038#elif defined(MFC_OpenMP)
5039# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5040
5041# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5042#endif
5043 do i = 1, num_dims
5044 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
5045 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
5046 end do
5047 flux_rsx_vf(j, k, l, &
5048 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
5049 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r))/(s_m &
5050 & - s_p)
5051 else
5052 flux_rsx_vf(j, k, l, &
5053 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
5054 & + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms &
5055 & - vel_l_rms)/2._wp
5056 end if
5057
5058 ! Elastic Stresses
5059 if (hypoelasticity) then
5060 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
5061 flux_rsx_vf(j, k, l, &
5062 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
5063 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
5064 & - rho_r*tau_e_r(i)))/(s_m - s_p)
5065 end do
5066 end if
5067
5068 ! Advection flux and source: interface velocity for volume fraction transport
5069
5070# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5071#if defined(MFC_OpenACC)
5072# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5073!$acc loop seq
5074# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5075#elif defined(MFC_OpenMP)
5076# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5077
5078# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5079#endif
5080 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5081 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j, k + 1, l, &
5082 & i))*s_m*s_p/(s_m - s_p)
5083 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j, k + 1, l, &
5084 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
5085 end do
5086
5087 if (bubbles_euler) then
5088 ! From HLLC: Kills mass transport @ bubble gas density
5089 if (num_fluids > 1) then
5090 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
5091 end if
5092 end if
5093
5094 if (chemistry) then
5095
5096# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5097#if defined(MFC_OpenACC)
5098# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5099!$acc loop seq
5100# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5101#elif defined(MFC_OpenMP)
5102# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5103
5104# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5105#endif
5106 do i = eqn_idx%species%beg, eqn_idx%species%end
5107 y_l = ql_prim_rsx_vf(j, k, l, i)
5108 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
5109
5110 flux_rsx_vf(j, k, l, &
5111 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
5112 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
5113 flux_src_rsx_vf(j, k, l, i) = 0._wp
5114 end do
5115 end if
5116
5117 ! MHD: magnetic flux and Maxwell stress contributions
5118 if (mhd) then
5119 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
5120 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
5121
5122# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5123#if defined(MFC_OpenACC)
5124# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5125!$acc loop seq
5126# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5127#elif defined(MFC_OpenMP)
5128# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5129
5130# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5131#endif
5132 do i = 0, 1
5133 flux_rsx_vf(j, k, l, &
5134 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
5135 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
5136 & - b%R(2 + i)))/(s_m - s_p)
5137 end do
5138 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
5139 ! B_x d/dy flux = (1 - delta(x,y)) * (v_y * B_x - v_x * B_y) B_y
5140 ! d/dy flux = (1 - delta(y,y)) * (v_y * B_y - v_y * B_y) B_z d/dy
5141 ! flux = (1 - delta(z,y)) * (v_y * B_z - v_z * B_y)
5142
5143# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5144#if defined(MFC_OpenACC)
5145# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5146!$acc loop seq
5147# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5148#elif defined(MFC_OpenMP)
5149# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5150
5151# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5152#endif
5153 do i = 0, 2
5154 flux_rsx_vf(j, k, l, &
5155 & eqn_idx%B%beg + i) = (1 - dir_flg(i + 1))*(s_m*(vel_r(dir_idx(1))*b%R(i + 1) &
5156 & - vel_r(i + 1)*b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i &
5157 & + 1)*b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
5158 end do
5159 end if
5160 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
5161 end if
5162
5163# 1346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5164 if (cyl_coord) then
5165 ! Substituting the advective flux into the inviscid geometrical source flux
5166
5167# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5168#if defined(MFC_OpenACC)
5169# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5170!$acc loop seq
5171# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5172#elif defined(MFC_OpenMP)
5173# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5174
5175# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5176#endif
5177 do i = 1, eqn_idx%E
5178 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
5179 end do
5180 ! Recalculating the radial momentum geometric source flux
5181 flux_gsrc_rsx_vf(j, k, l, eqn_idx%cont%end + 2) = flux_rsx_vf(j, k, l, &
5182 & eqn_idx%cont%end + 2) - (s_m*pres_r - s_p*pres_l)/(s_m - s_p)
5183 ! Geometrical source of the void fraction(s) is zero
5184
5185# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5186#if defined(MFC_OpenACC)
5187# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5188!$acc loop seq
5189# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5190#elif defined(MFC_OpenMP)
5191# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5192
5193# 1356 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5194#endif
5195 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5196 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
5197 end do
5198 end if
5199
5200 if (cyl_coord .and. hypoelasticity) then
5201 ! += tau_sigmasigma using HLL
5202 flux_gsrc_rsx_vf(j, k, l, eqn_idx%cont%end + 2) = flux_gsrc_rsx_vf(j, k, l, &
5203 & eqn_idx%cont%end + 2) + (s_m*tau_e_r(4) - s_p*tau_e_l(4))/(s_m - s_p)
5204
5205
5206# 1367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5207#if defined(MFC_OpenACC)
5208# 1367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5209!$acc loop seq
5210# 1367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5211#elif defined(MFC_OpenMP)
5212# 1367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5213
5214# 1367 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5215#endif
5216 do i = eqn_idx%stress%beg, eqn_idx%stress%end
5217 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
5218 end do
5219 end if
5220# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5221 end do
5222 end do
5223 end do
5224
5225# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5226#if defined(MFC_OpenACC)
5227# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5228!$acc end parallel loop
5229# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5230#elif defined(MFC_OpenMP)
5231# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5232
5233# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5234!$omp end target teams loop
5235# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5236#endif
5237 end if
5238# 891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5239# 892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5240# 893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5241 if (norm_dir == 3) then
5242
5243# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5244
5245# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5246#if defined(MFC_OpenACC)
5247# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5248!$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)
5249# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5250#elif defined(MFC_OpenMP)
5251# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5252
5253# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5254
5255# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5256
5257# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5258!$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)
5259# 894 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5260#endif
5261# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5262 do l = is1%beg, is1%end
5263 do k = is2%beg, is2%end
5264 do j = is3%beg, is3%end
5265
5266# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5267#if defined(MFC_OpenACC)
5268# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5269!$acc loop seq
5270# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5271#elif defined(MFC_OpenMP)
5272# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5273
5274# 906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5275#endif
5276 do i = 1, eqn_idx%cont%end
5277 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
5278 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
5279 end do
5280
5281 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5282
5283
5284# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5285#if defined(MFC_OpenACC)
5286# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5287!$acc loop seq
5288# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5289#elif defined(MFC_OpenMP)
5290# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5291
5292# 914 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5293#endif
5294 do i = 1, num_vels
5295 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
5296 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
5297 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5298 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5299 end do
5300
5301
5302# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5303#if defined(MFC_OpenACC)
5304# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5305!$acc loop seq
5306# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5307#elif defined(MFC_OpenMP)
5308# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5309
5310# 922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5311#endif
5312 do i = 1, num_fluids
5313 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5314 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
5315 end do
5316
5317 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
5318 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
5319
5320 if (mhd) then
5321 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
5322 b%L(1) = bx0
5323 b%R(1) = bx0
5324 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
5325 b%R(2) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg)
5326 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
5327 b%R(3) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + 1)
5328 else ! 2D/3D: Bx, By, Bz as variables
5329 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
5330 b%R(1) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg)
5331 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
5332 b%R(2) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + 1)
5333 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
5334 b%R(3) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + 2)
5335 end if
5336 end if
5337
5338 rho_l = 0._wp
5339 gamma_l = 0._wp
5340 pi_inf_l = 0._wp
5341 qv_l = 0._wp
5342
5343 rho_r = 0._wp
5344 gamma_r = 0._wp
5345 pi_inf_r = 0._wp
5346 qv_r = 0._wp
5347
5348 alpha_l_sum = 0._wp
5349 alpha_r_sum = 0._wp
5350
5351 pres_mag%L = 0._wp
5352 pres_mag%R = 0._wp
5353
5354 if (mpp_lim) then
5355
5356# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5357#if defined(MFC_OpenACC)
5358# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5359!$acc loop seq
5360# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5361#elif defined(MFC_OpenMP)
5362# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5363
5364# 966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5365#endif
5366 do i = 1, num_fluids
5367 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
5368 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
5369 alpha_l_sum = alpha_l_sum + alpha_l(i)
5370 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
5371 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
5372 alpha_r_sum = alpha_r_sum + alpha_r(i)
5373 end do
5374
5375 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
5376 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
5377 end if
5378
5379
5380# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5381#if defined(MFC_OpenACC)
5382# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5383!$acc loop seq
5384# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5385#elif defined(MFC_OpenMP)
5386# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5387
5388# 980 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5389#endif
5390 do i = 1, num_fluids
5391 rho_l = rho_l + alpha_rho_l(i)
5392 gamma_l = gamma_l + alpha_l(i)*gammas(i)
5393 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
5394 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
5395
5396 rho_r = rho_r + alpha_rho_r(i)
5397 gamma_r = gamma_r + alpha_r(i)*gammas(i)
5398 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
5399 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
5400 end do
5401
5402 if (viscous) then
5403
5404# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5405#if defined(MFC_OpenACC)
5406# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5407!$acc loop seq
5408# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5409#elif defined(MFC_OpenMP)
5410# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5411
5412# 994 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5413#endif
5414 do i = 1, 2
5415 re_l(i) = dflt_real
5416 re_r(i) = dflt_real
5417
5418 if (re_size(i) > 0) re_l(i) = 0._wp
5419 if (re_size(i) > 0) re_r(i) = 0._wp
5420
5421
5422# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5423#if defined(MFC_OpenACC)
5424# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5425!$acc loop seq
5426# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5427#elif defined(MFC_OpenMP)
5428# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5429
5430# 1002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5431#endif
5432 do q = 1, re_size(i)
5433 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
5434 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
5435 end do
5436
5437 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
5438 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
5439 end do
5440 end if
5441
5442 if (chemistry) then
5443
5444# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5445#if defined(MFC_OpenACC)
5446# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5447!$acc loop seq
5448# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5449#elif defined(MFC_OpenMP)
5450# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5451
5452# 1014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5453#endif
5454 do i = eqn_idx%species%beg, eqn_idx%species%end
5455 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
5456 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
5457 end do
5458
5459 call get_mixture_molecular_weight(ys_l, mw_l)
5460 call get_mixture_molecular_weight(ys_r, mw_r)
5461
5462 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
5463 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
5464
5465 r_gas_l = gas_constant/mw_l
5466 r_gas_r = gas_constant/mw_r
5467 t_l = pres_l/rho_l/r_gas_l
5468 t_r = pres_r/rho_r/r_gas_r
5469
5470 call get_species_specific_heats_r(t_l, cp_il)
5471 call get_species_specific_heats_r(t_r, cp_ir)
5472
5473 if (chem_params%gamma_method == 1) then
5474 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
5475 gamma_il = cp_il/(cp_il - 1.0_wp)
5476 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
5477
5478 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
5479 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
5480 else if (chem_params%gamma_method == 2) then
5481 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
5482 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
5483 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
5484 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
5485 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
5486
5487 gamm_l = cp_l/cv_l
5488 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
5489 gamm_r = cp_r/cv_r
5490 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
5491 end if
5492
5493 call get_mixture_energy_mass(t_l, ys_l, e_l)
5494 call get_mixture_energy_mass(t_r, ys_r, e_r)
5495
5496 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
5497 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
5498 h_l = (e_l + pres_l)/rho_l
5499 h_r = (e_r + pres_r)/rho_r
5500 else if (mhd .and. relativity) then
5501# 1063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5502 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
5503 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
5504 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
5505 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
5506
5507 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
5508 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
5509 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
5510 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
5511
5512 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
5513 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
5514
5515 ! Hard-coded EOS
5516 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
5517 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
5518
5519 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
5520 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
5521
5522 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
5523 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
5524# 1086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5525 else if (mhd .and. .not. relativity) then
5526 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
5527 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
5528 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
5529 ! includes magnetic energy
5530 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R
5531 h_l = (e_l + pres_l - pres_mag%L)/rho_l
5532 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
5533 h_r = (e_r + pres_r - pres_mag%R)/rho_r
5534 else
5535 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
5536 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
5537 h_l = (e_l + pres_l)/rho_l
5538 h_r = (e_r + pres_r)/rho_r
5539 end if
5540
5541 ! elastic energy update
5542 if (hypoelasticity) then
5543 g_l = 0._wp; g_r = 0._wp
5544
5545
5546# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5547#if defined(MFC_OpenACC)
5548# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5549!$acc loop seq
5550# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5551#elif defined(MFC_OpenMP)
5552# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5553
5554# 1106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5555#endif
5556 do i = 1, num_fluids
5557 g_l = g_l + alpha_l(i)*gs_rs(i)
5558 g_r = g_r + alpha_r(i)*gs_rs(i)
5559 end do
5560
5561 if (cont_damage) then
5562 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
5563 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
5564 end if
5565
5566 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
5567 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
5568 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
5569 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
5570 if ((g_l > 1000) .and. (g_r > 1000)) then
5571 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5572 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5573 ! Double for shear stresses
5574 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
5575 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5576 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5577 end if
5578 end if
5579 end do
5580 end if
5581
5582 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, &
5583 & qv_l)
5584
5585 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, &
5586 & qv_r)
5587
5588 if (mhd) then
5589 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
5590 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
5591 end if
5592
5593 s_l = 0._wp; s_r = 0._wp
5594
5595
5596# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5597#if defined(MFC_OpenACC)
5598# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5599!$acc loop seq
5600# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5601#elif defined(MFC_OpenMP)
5602# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5603
5604# 1146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5605#endif
5606 do i = 1, num_dims
5607 s_l = s_l + vel_l(i)**2._wp
5608 s_r = s_r + vel_r(i)**2._wp
5609 end do
5610
5611 s_l = sqrt(s_l)
5612 s_r = sqrt(s_r)
5613
5614 s_p = max(s_l, s_r) + max(c_l, c_r)
5615 s_m = -s_p
5616
5617 s_l = s_m
5618 s_r = s_p
5619
5620 ! Low Mach correction
5621 if (low_mach == 1) then
5622 if (riemann_solver == 1 .or. riemann_solver == 5) then
5623# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5624 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5625# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5626 pcorr = 0._wp
5627# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5628
5629# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5630 if (low_mach == 1) then
5631# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5632 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5633# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5634 end if
5635# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5636 else if (riemann_solver == 2) then
5637# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5638 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5639# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5640 pcorr = 0._wp
5641# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5642
5643# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5644 if (low_mach == 1) then
5645# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5646 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))) &
5647# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5648 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5649# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5650 else if (low_mach == 2) then
5651# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5652 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))))
5653# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5654 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))))
5655# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5656 vel_l(dir_idx(1)) = vel_l_tmp
5657# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5658 vel_r(dir_idx(1)) = vel_r_tmp
5659# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5660 end if
5661# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5662 end if
5663 else
5664 pcorr = 0._wp
5665 end if
5666
5667 ! Mass
5668 if (.not. relativity) then
5669
5670# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5671#if defined(MFC_OpenACC)
5672# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5673!$acc loop seq
5674# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5675#elif defined(MFC_OpenMP)
5676# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5677
5678# 1170 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5679#endif
5680 do i = 1, eqn_idx%cont%end
5681 flux_rsx_vf(j, k, l, &
5682 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
5683 & + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
5684 end do
5685 else if (relativity) then
5686
5687# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5688#if defined(MFC_OpenACC)
5689# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5690!$acc loop seq
5691# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5692#elif defined(MFC_OpenMP)
5693# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5694
5695# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5696#endif
5697 do i = 1, eqn_idx%cont%end
5698 flux_rsx_vf(j, k, l, &
5699 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
5700 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i)))/(s_m &
5701 & - s_p)
5702 end do
5703 end if
5704
5705 ! Momentum
5706 if (mhd .and. (.not. relativity)) then
5707
5708# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5709#if defined(MFC_OpenACC)
5710# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5711!$acc loop seq
5712# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5713#elif defined(MFC_OpenMP)
5714# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5715
5716# 1188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5717#endif
5718 do i = 1, 3
5719 ! Flux of rho*v_i in the z direction = rho * v_i * v_z - B_i * B_z +
5720 ! delta_(z,i) * p_tot
5721 flux_rsx_vf(j, k, l, &
5722 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
5723 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
5724 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
5725 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
5726 end do
5727 else if (mhd .and. relativity) then
5728
5729# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5730#if defined(MFC_OpenACC)
5731# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5732!$acc loop seq
5733# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5734#elif defined(MFC_OpenMP)
5735# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5736
5737# 1199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5738#endif
5739 do i = 1, 3
5740 ! Flux of m_i in the z direction = m_i * v_z - b_i/Gamma * B_z +
5741 ! delta_(z,i) * p_tot
5742 flux_rsx_vf(j, k, l, &
5743 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
5744 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
5745 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
5746 & ) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
5747 end do
5748 else if (bubbles_euler) then
5749
5750# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5751#if defined(MFC_OpenACC)
5752# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5753!$acc loop seq
5754# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5755#elif defined(MFC_OpenMP)
5756# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5757
5758# 1210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5759#endif
5760 do i = 1, num_vels
5761 flux_rsx_vf(j, k, l, &
5762 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5763 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
5764 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
5765 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
5766 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5767 end do
5768 else if (hypoelasticity) then
5769
5770# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5771#if defined(MFC_OpenACC)
5772# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5773!$acc loop seq
5774# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5775#elif defined(MFC_OpenMP)
5776# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5777
5778# 1220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5779#endif
5780 do i = 1, num_vels
5781 flux_rsx_vf(j, k, l, &
5782 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5783 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
5784 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l &
5785 & - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5786 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
5787 end do
5788 else
5789
5790# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5791#if defined(MFC_OpenACC)
5792# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5793!$acc loop seq
5794# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5795#elif defined(MFC_OpenMP)
5796# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5797
5798# 1230 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5799#endif
5800 do i = 1, num_vels
5801 flux_rsx_vf(j, k, l, &
5802 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5803 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
5804 & + dir_flg(dir_idx(i))*pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5805 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
5806 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5807 end do
5808 end if
5809
5810 ! Energy
5811 if (mhd .and. (.not. relativity)) then
5812 ! energy flux = (E + p + p_mag) * v_z - B_z * (v_x*B_x + v_y*B_y + v_z*B_z)
5813# 1245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5814 flux_rsx_vf(j, k, l, &
5815 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
5816 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) - s_p*(vel_l(norm_dir) &
5817 & *(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) &
5818 & + vel_l(3)*b%L(3))) + s_m*s_p*(e_l - e_r))/(s_m - s_p)
5819# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5820 else if (mhd .and. relativity) then
5821 ! energy flux = m_z - mass flux Hard-coded for single-component for now
5822 flux_rsx_vf(j, k, l, &
5823 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
5824 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l - e_r)) &
5825 & /(s_m - s_p)
5826 else if (bubbles_euler) then
5827 flux_rsx_vf(j, k, l, &
5828 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) - s_p*vel_l(dir_idx(1) &
5829 & )*(e_l + pres_l - ptilde_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
5830 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
5831 else if (hypoelasticity) then
5832 flux_tau_l = 0._wp; flux_tau_r = 0._wp
5833
5834# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5835#if defined(MFC_OpenACC)
5836# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5837!$acc loop seq
5838# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5839#elif defined(MFC_OpenMP)
5840# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5841
5842# 1264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5843#endif
5844 do i = 1, num_dims
5845 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
5846 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
5847 end do
5848 flux_rsx_vf(j, k, l, &
5849 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
5850 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r))/(s_m &
5851 & - s_p)
5852 else
5853 flux_rsx_vf(j, k, l, &
5854 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
5855 & + pres_l) + s_m*s_p*(e_l - e_r))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms &
5856 & - vel_l_rms)/2._wp
5857 end if
5858
5859 ! Elastic Stresses
5860 if (hypoelasticity) then
5861 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
5862 flux_rsx_vf(j, k, l, &
5863 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
5864 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
5865 & - rho_r*tau_e_r(i)))/(s_m - s_p)
5866 end do
5867 end if
5868
5869 ! Advection flux and source: interface velocity for volume fraction transport
5870
5871# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5872#if defined(MFC_OpenACC)
5873# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5874!$acc loop seq
5875# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5876#elif defined(MFC_OpenMP)
5877# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5878
5879# 1291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5880#endif
5881 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5882 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j, k, l + 1, &
5883 & i))*s_m*s_p/(s_m - s_p)
5884 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j, k, l + 1, &
5885 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
5886 end do
5887
5888 if (bubbles_euler) then
5889 ! From HLLC: Kills mass transport @ bubble gas density
5890 if (num_fluids > 1) then
5891 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
5892 end if
5893 end if
5894
5895 if (chemistry) then
5896
5897# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5898#if defined(MFC_OpenACC)
5899# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5900!$acc loop seq
5901# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5902#elif defined(MFC_OpenMP)
5903# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5904
5905# 1307 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5906#endif
5907 do i = eqn_idx%species%beg, eqn_idx%species%end
5908 y_l = ql_prim_rsx_vf(j, k, l, i)
5909 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
5910
5911 flux_rsx_vf(j, k, l, &
5912 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
5913 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
5914 flux_src_rsx_vf(j, k, l, i) = 0._wp
5915 end do
5916 end if
5917
5918 ! MHD: magnetic flux and Maxwell stress contributions
5919 if (mhd) then
5920 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
5921 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
5922
5923# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5924#if defined(MFC_OpenACC)
5925# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5926!$acc loop seq
5927# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5928#elif defined(MFC_OpenMP)
5929# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5930
5931# 1323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5932#endif
5933 do i = 0, 1
5934 flux_rsx_vf(j, k, l, &
5935 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
5936 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
5937 & - b%R(2 + i)))/(s_m - s_p)
5938 end do
5939 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
5940 ! B_x d/dz flux = (1 - delta(x,z)) * (v_z * B_x - v_x * B_z) B_y
5941 ! d/dz flux = (1 - delta(y,z)) * (v_z * B_y - v_y * B_z) B_z d/dz
5942 ! flux = (1 - delta(z,z)) * (v_z * B_z - v_z * B_z)
5943
5944# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5945#if defined(MFC_OpenACC)
5946# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5947!$acc loop seq
5948# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5949#elif defined(MFC_OpenMP)
5950# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5951
5952# 1334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5953#endif
5954 do i = 0, 2
5955 flux_rsx_vf(j, k, l, &
5956 & eqn_idx%B%beg + i) = (1 - dir_flg(i + 1))*(s_m*(vel_r(dir_idx(1))*b%R(i + 1) &
5957 & - vel_r(i + 1)*b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i &
5958 & + 1)*b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
5959 end do
5960 end if
5961 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
5962 end if
5963
5964# 1373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5965 end do
5966 end do
5967 end do
5968
5969# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5970#if defined(MFC_OpenACC)
5971# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5972!$acc end parallel loop
5973# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5974#elif defined(MFC_OpenMP)
5975# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5976
5977# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5978!$omp end target teams loop
5979# 1376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5980#endif
5981 end if
5982# 1379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5983
5984 if (viscous) then
5985
5986# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5987
5988# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5989#if defined(MFC_OpenACC)
5990# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5991!$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)
5992# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5993#elif defined(MFC_OpenMP)
5994# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5995
5996# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5997
5998# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5999
6000# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6001!$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)
6002# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6003#endif
6004# 1383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6005 do l = isz%beg, isz%end
6006 do k = isy%beg, isy%end
6007 do j = isx%beg, isx%end
6008 idx_right_phys(1) = j
6009 idx_right_phys(2) = k
6010 idx_right_phys(3) = l
6011 idx_right_phys(norm_dir) = idx_right_phys(norm_dir) + 1
6012
6013 if (norm_dir == 1) then
6014
6015# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6016#if defined(MFC_OpenACC)
6017# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6018!$acc loop seq
6019# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6020#elif defined(MFC_OpenMP)
6021# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6022
6023# 1392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6024#endif
6025 do i = 1, num_fluids
6026 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6027 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
6028 end do
6029
6030
6031# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6032#if defined(MFC_OpenACC)
6033# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6034!$acc loop seq
6035# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6036#elif defined(MFC_OpenMP)
6037# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6038
6039# 1398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6040#endif
6041 do i = 1, num_dims
6042 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%mom%beg + i - 1)
6043 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%mom%beg + i - 1)
6044 end do
6045 else if (norm_dir == 2) then
6046
6047# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6048#if defined(MFC_OpenACC)
6049# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6050!$acc loop seq
6051# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6052#elif defined(MFC_OpenMP)
6053# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6054
6055# 1404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6056#endif
6057 do i = 1, num_fluids
6058 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6059 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
6060 end do
6061
6062# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6063#if defined(MFC_OpenACC)
6064# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6065!$acc loop seq
6066# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6067#elif defined(MFC_OpenMP)
6068# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6069
6070# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6071#endif
6072 do i = 1, num_dims
6073 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%mom%beg + i - 1)
6074 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%mom%beg + i - 1)
6075 end do
6076 else
6077
6078# 1415 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6079#if defined(MFC_OpenACC)
6080# 1415 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6081!$acc loop seq
6082# 1415 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6083#elif defined(MFC_OpenMP)
6084# 1415 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6085
6086# 1415 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6087#endif
6088 do i = 1, num_fluids
6089 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6090 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
6091 end do
6092
6093
6094# 1421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6095#if defined(MFC_OpenACC)
6096# 1421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6097!$acc loop seq
6098# 1421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6099#elif defined(MFC_OpenMP)
6100# 1421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6101
6102# 1421 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6103#endif
6104 do i = 1, num_dims
6105 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%mom%beg + i - 1)
6106 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%mom%beg + i - 1)
6107 end do
6108 end if
6109
6110
6111# 1428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6112#if defined(MFC_OpenACC)
6113# 1428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6114!$acc loop seq
6115# 1428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6116#elif defined(MFC_OpenMP)
6117# 1428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6118
6119# 1428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6120#endif
6121 do i = 1, 2
6122 re_l(i) = dflt_real
6123 re_r(i) = dflt_real
6124
6125 if (re_size(i) > 0) re_l(i) = 0._wp
6126 if (re_size(i) > 0) re_r(i) = 0._wp
6127
6128
6129# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6130#if defined(MFC_OpenACC)
6131# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6132!$acc loop seq
6133# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6134#elif defined(MFC_OpenMP)
6135# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6136
6137# 1436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6138#endif
6139 do q = 1, re_size(i)
6140 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
6141 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
6142 end do
6143
6144 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6145 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6146 end do
6147
6148 if (shear_stress) then
6149
6150# 1447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6151#if defined(MFC_OpenACC)
6152# 1447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6153!$acc loop seq
6154# 1447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6155#elif defined(MFC_OpenMP)
6156# 1447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6157
6158# 1447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6159#endif
6160 do i = 1, num_dims
6161 vel_grad_l(i, 1) = (dql_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(1))
6162 vel_grad_r(i, 1) = (dqr_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6163 & idx_right_phys(2), idx_right_phys(3))/re_r(1))
6164# 1453 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6165 if (num_dims > 1) then
6166 vel_grad_l(i, 2) = (dql_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(1))
6167 vel_grad_r(i, 2) = (dqr_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6168 & idx_right_phys(2), idx_right_phys(3))/re_r(1))
6169 end if
6170# 1459 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6171 if (num_dims > 2) then
6172 vel_grad_l(i, 3) = (dql_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(1))
6173 vel_grad_r(i, 3) = (dqr_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6174 & idx_right_phys(2), idx_right_phys(3))/re_r(1))
6175 end if
6176# 1465 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6177# 1466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6178 end do
6179
6180 if (norm_dir == 1) then
6181 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6182 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6183 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6184 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(1) + vel_grad_r(1, 1)*vel_r(1))
6185# 1474 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6186 if (num_dims > 1) then
6187 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6188 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6189 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6190 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(1) + vel_grad_r(2, &
6191 & 2)*vel_r(1))
6192
6193 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6194 & l) - 0.5_wp*(vel_grad_l(1, 2) + vel_grad_r(1, 2)) - 0.5_wp*(vel_grad_l(2, &
6195 & 1) + vel_grad_r(2, 1))
6196 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6197 & l) - 0.5_wp*(vel_grad_l(1, 2)*vel_l(2) + vel_grad_r(1, &
6198 & 2)*vel_r(2)) - 0.5_wp*(vel_grad_l(2, 1)*vel_l(2) + vel_grad_r(2, 1)*vel_r(2))
6199# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6200 if (num_dims > 2) then
6201 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6202 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6203 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6204 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, &
6205 & 3)*vel_l(1) + vel_grad_r(3, 3)*vel_r(1))
6206
6207 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6208 & l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6209 & l) - 0.5_wp*(vel_grad_l(1, 3) + vel_grad_r(1, &
6210 & 3)) - 0.5_wp*(vel_grad_l(3, 1) + vel_grad_r(3, 1))
6211 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6212 & l) - 0.5_wp*(vel_grad_l(1, 3)*vel_l(3) + vel_grad_r(1, &
6213 & 3)*vel_r(3)) - 0.5_wp*(vel_grad_l(3, 1)*vel_l(3) + vel_grad_r(3, &
6214 & 1)*vel_r(3))
6215 end if
6216# 1505 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6217 end if
6218# 1507 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6219 else if (norm_dir == 2) then
6220# 1509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6221 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6222 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6223 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6224 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(2) + vel_grad_r(1, 1)*vel_r(2))
6225
6226 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6227 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6228 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6229 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(2) + vel_grad_r(2, 2)*vel_r(2))
6230
6231 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6232 & l) - 0.5_wp*(vel_grad_l(1, 2) + vel_grad_r(1, 2)) - 0.5_wp*(vel_grad_l(2, &
6233 & 1) + vel_grad_r(2, 1))
6234 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6235 & l) - 0.5_wp*(vel_grad_l(1, 2)*vel_l(1) + vel_grad_r(1, &
6236 & 2)*vel_r(1)) - 0.5_wp*(vel_grad_l(2, 1)*vel_l(1) + vel_grad_r(2, 1)*vel_r(1))
6237# 1526 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6238 if (num_dims > 2) then
6239 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, &
6240 & k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6241 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6242 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3)*vel_l(2) + vel_grad_r(3, &
6243 & 3)*vel_r(2))
6244
6245 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, &
6246 & k, l) - 0.5_wp*(vel_grad_l(2, 3) + vel_grad_r(2, &
6247 & 3)) - 0.5_wp*(vel_grad_l(3, 2) + vel_grad_r(3, 2))
6248 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6249 & l) - 0.5_wp*(vel_grad_l(2, 3)*vel_l(3) + vel_grad_r(2, &
6250 & 3)*vel_r(3)) - 0.5_wp*(vel_grad_l(3, 2)*vel_l(3) + vel_grad_r(3, &
6251 & 2)*vel_r(3))
6252 end if
6253# 1542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6254# 1543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6255 else
6256# 1545 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6257 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6258 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6259 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6260 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(3) + vel_grad_r(1, 1)*vel_r(3))
6261
6262 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6263 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6264 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6265 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(3) + vel_grad_r(2, 2)*vel_r(3))
6266
6267 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6268 & l) - 0.5_wp*(vel_grad_l(1, 3) + vel_grad_r(1, 3)) - 0.5_wp*(vel_grad_l(3, &
6269 & 1) + vel_grad_r(3, 1))
6270 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6271 & l) - 0.5_wp*(vel_grad_l(1, 3)*vel_l(1) + vel_grad_r(1, &
6272 & 3)*vel_r(1)) - 0.5_wp*(vel_grad_l(3, 1)*vel_l(1) + vel_grad_r(3, 1)*vel_r(1))
6273
6274 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6275 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6276 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6277 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3)*vel_l(3) + vel_grad_r(3, 3)*vel_r(3))
6278
6279 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6280 & l) - 0.5_wp*(vel_grad_l(2, 3) + vel_grad_r(2, 3)) - 0.5_wp*(vel_grad_l(3, &
6281 & 2) + vel_grad_r(3, 2))
6282 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6283 & l) - 0.5_wp*(vel_grad_l(2, 3)*vel_l(2) + vel_grad_r(2, &
6284 & 3)*vel_r(2)) - 0.5_wp*(vel_grad_l(3, 2)*vel_l(2) + vel_grad_r(3, 2)*vel_r(2))
6285# 1574 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6286 end if
6287 end if
6288
6289 if (bulk_stress) then
6290
6291# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6292#if defined(MFC_OpenACC)
6293# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6294!$acc loop seq
6295# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6296#elif defined(MFC_OpenMP)
6297# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6298
6299# 1578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6300#endif
6301 do i = 1, num_dims
6302 vel_grad_l(i, 1) = (dql_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(2))
6303 vel_grad_r(i, 1) = (dqr_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6304 & idx_right_phys(2), idx_right_phys(3))/re_r(2))
6305# 1584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6306 if (num_dims > 1) then
6307 vel_grad_l(i, 2) = (dql_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(2))
6308 vel_grad_r(i, 2) = (dqr_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6309 & idx_right_phys(2), idx_right_phys(3))/re_r(2))
6310 end if
6311# 1590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6312# 1591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6313 if (num_dims > 2) then
6314 vel_grad_l(i, 3) = (dql_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(2))
6315 vel_grad_r(i, 3) = (dqr_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6316 & idx_right_phys(2), idx_right_phys(3))/re_r(2))
6317 end if
6318# 1597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6319 end do
6320
6321 if (norm_dir == 1) then
6322 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6323 & l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6324 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, &
6325 & 1)*vel_l(1) + vel_grad_r(1, 1)*vel_r(1))
6326# 1605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6327 if (num_dims > 1) then
6328 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6329 & l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6330 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6331 & l) - 0.5_wp*(vel_grad_l(2, 2)*vel_l(1) + vel_grad_r(2, 2)*vel_r(1))
6332
6333# 1612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6334 if (num_dims > 2) then
6335 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6336 & l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6337 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6338 & l) - 0.5_wp*(vel_grad_l(3, 3)*vel_l(1) + vel_grad_r(3, 3)*vel_r(1))
6339 end if
6340# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6341 end if
6342# 1621 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6343 else if (norm_dir == 2) then
6344# 1623 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6345 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6346 & l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6347 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6348 & l) - 0.5_wp*(vel_grad_l(1, 1)*vel_l(2) + vel_grad_r(1, 1)*vel_r(2))
6349
6350 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6351 & l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6352 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6353 & l) - 0.5_wp*(vel_grad_l(2, 2)*vel_l(2) + vel_grad_r(2, 2)*vel_r(2))
6354
6355# 1634 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6356 if (num_dims > 2) then
6357 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, &
6358 & k, l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6359 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6360 & l) - 0.5_wp*(vel_grad_l(3, 3)*vel_l(2) + vel_grad_r(3, 3)*vel_r(2))
6361 end if
6362# 1641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6363# 1642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6364 else
6365# 1644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6366 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6367 & l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6368 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6369 & l) - 0.5_wp*(vel_grad_l(1, 1)*vel_l(3) + vel_grad_r(1, 1)*vel_r(3))
6370
6371 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6372 & l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6373 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6374 & l) - 0.5_wp*(vel_grad_l(2, 2)*vel_l(3) + vel_grad_r(2, 2)*vel_r(3))
6375
6376 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6377 & l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6378 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6379 & l) - 0.5_wp*(vel_grad_l(3, 3)*vel_l(3) + vel_grad_r(3, 3)*vel_r(3))
6380# 1659 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6381 end if
6382 end if
6383 end do
6384 end do
6385 end do
6386
6387# 1664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6388#if defined(MFC_OpenACC)
6389# 1664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6390!$acc end parallel loop
6391# 1664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6392#elif defined(MFC_OpenMP)
6393# 1664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6394
6395# 1664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6396!$omp end target teams loop
6397# 1664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6398#endif
6399 end if
6400
6401 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
6402
6403 end subroutine s_lf_riemann_solver
6404
6405 !> HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994)
6406 subroutine s_hllc_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, &
6407
6408 & dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, &
6409 & flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
6410
6411 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, qr_prim_rsx_vf
6412 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
6413 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
6414 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
6415 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
6416
6417 ! Intercell fluxes
6418 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
6419 integer, intent(in) :: norm_dir
6420 type(int_bounds_info), intent(in) :: ix, iy, iz
6421
6422# 1693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6423 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
6424 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
6425 real(wp), dimension(num_dims) :: vel_l, vel_r
6426# 1697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6427
6428 real(wp) :: rho_l, rho_r
6429 real(wp) :: pres_l, pres_r
6430 real(wp) :: e_l, e_r
6431 real(wp) :: h_l, h_r
6432# 1706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6433 real(wp), dimension(num_species) :: ys_l, ys_r, xs_l, xs_r, gamma_il, gamma_ir, cp_il, cp_ir
6434 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
6435# 1709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6436 real(wp) :: cp_avg, cv_avg, t_avg, c_sum_yi_phi, eps
6437 real(wp) :: t_l, t_r
6438 real(wp) :: mw_l, mw_r
6439 real(wp) :: r_gas_l, r_gas_r
6440 real(wp) :: cp_l, cp_r
6441 real(wp) :: cv_l, cv_r
6442 real(wp) :: gamm_l, gamm_r
6443 real(wp) :: y_l, y_r
6444 real(wp) :: gamma_l, gamma_r
6445 real(wp) :: pi_inf_l, pi_inf_r
6446 real(wp) :: qv_l, qv_r
6447 real(wp) :: c_l, c_r
6448 real(wp), dimension(2) :: re_l, re_r
6449 real(wp) :: rho_avg
6450 real(wp) :: h_avg
6451 real(wp) :: gamma_avg
6452 real(wp) :: qv_avg
6453 real(wp) :: c_avg
6454 real(wp) :: s_l, s_r, s_m, s_p, s_s
6455 real(wp) :: xi_l, xi_r !< Left and right wave speeds functions
6456 real(wp) :: xi_l_m1, xi_r_m1 !< xi_L/R - 1, computed without cancellation
6457 real(wp) :: xi_m, xi_p
6458 real(wp) :: xi_mp, xi_pp
6459# 1738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6460 real(wp), dimension(nb) :: r0_l, r0_r
6461 real(wp), dimension(nb) :: v0_l, v0_r
6462 real(wp), dimension(nb) :: p0_l, p0_r
6463 real(wp), dimension(nb) :: pbw_l, pbw_r
6464# 1743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6465
6466 real(wp) :: alpha_l_sum, alpha_r_sum, nbub_l, nbub_r
6467 real(wp) :: ptilde_l, ptilde_r
6468 real(wp) :: pbwr3lbar, pbwr3rbar
6469 real(wp) :: r3lbar, r3rbar
6470 real(wp) :: r3v2lbar, r3v2rbar
6471 real(wp), dimension(6) :: tau_e_l, tau_e_r
6472# 1753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6473 real(wp), dimension(num_dims) :: xi_field_l, xi_field_r
6474# 1755 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6475 real(wp) :: g_l, g_r
6476 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
6477 real(wp) :: vel_l_tmp, vel_r_tmp
6478 real(wp) :: rho_star, e_star, p_star, p_k_star, vel_k_star
6479 real(wp) :: pres_sl, pres_sr, ms_l, ms_r
6480 real(wp) :: flux_ene_e
6481 real(wp) :: zcoef, pcorr !< low Mach number correction
6482 integer :: re_max, i, j, k, l, q !< Generic loop iterators
6483 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
6484
6485 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
6486 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
6487
6488 ! Reshaping inputted data based on dimensional splitting direction
6489
6490 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
6491
6492# 1776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6493# 1777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6494# 1778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6495 if (norm_dir == 1) then
6496 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
6497 if (model_eqns == 3) then
6498 ! 6-equation model (model_eqns=3): separate phasic internal energies
6499
6500# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6501
6502# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6503#if defined(MFC_OpenACC)
6504# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6505!$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_L_m1, xi_R_m1, xi_MP, xi_PP)
6506# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6507#elif defined(MFC_OpenMP)
6508# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6509
6510# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6511
6512# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6513
6514# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6515!$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_L_m1, xi_R_m1, xi_MP, xi_PP)
6516# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6517#endif
6518# 1792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6519 do l = is3%beg, is3%end
6520 do k = is2%beg, is2%end
6521 do j = is1%beg, is1%end
6522 vel_l_rms = 0._wp; vel_r_rms = 0._wp
6523 rho_l = 0._wp; rho_r = 0._wp
6524 gamma_l = 0._wp; gamma_r = 0._wp
6525 pi_inf_l = 0._wp; pi_inf_r = 0._wp
6526 qv_l = 0._wp; qv_r = 0._wp
6527 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
6528
6529
6530# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6531#if defined(MFC_OpenACC)
6532# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6533!$acc loop seq
6534# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6535#elif defined(MFC_OpenMP)
6536# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6537
6538# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6539#endif
6540 do i = 1, num_dims
6541 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
6542 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
6543 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
6544 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
6545 end do
6546
6547 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
6548 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
6549
6550 rho_l = 0._wp
6551 gamma_l = 0._wp
6552 pi_inf_l = 0._wp
6553 qv_l = 0._wp
6554
6555 rho_r = 0._wp
6556 gamma_r = 0._wp
6557 pi_inf_r = 0._wp
6558 qv_r = 0._wp
6559
6560 alpha_l_sum = 0._wp
6561 alpha_r_sum = 0._wp
6562
6563 if (mpp_lim) then
6564
6565# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6566#if defined(MFC_OpenACC)
6567# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6568!$acc loop seq
6569# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6570#elif defined(MFC_OpenMP)
6571# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6572
6573# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6574#endif
6575 do i = 1, num_fluids
6576 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
6577 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
6578 & eqn_idx%E + i)), 1._wp)
6579 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6580 end do
6581
6582
6583# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6584#if defined(MFC_OpenACC)
6585# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6586!$acc loop seq
6587# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6588#elif defined(MFC_OpenMP)
6589# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6590
6591# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6592#endif
6593 do i = 1, num_fluids
6594 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
6595 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
6596 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
6597 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
6598 end do
6599
6600
6601# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6602#if defined(MFC_OpenACC)
6603# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6604!$acc loop seq
6605# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6606#elif defined(MFC_OpenMP)
6607# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6608
6609# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6610#endif
6611 do i = 1, num_fluids
6612 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
6613 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
6614 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
6615 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
6616 end do
6617 end if
6618
6619
6620# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6621#if defined(MFC_OpenACC)
6622# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6623!$acc loop seq
6624# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6625#elif defined(MFC_OpenMP)
6626# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6627
6628# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6629#endif
6630 do i = 1, num_fluids
6631 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
6632 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
6633 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
6634 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
6635
6636 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
6637 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
6638 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
6639 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
6640
6641 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
6642 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%adv%beg + i - 1)
6643 end do
6644
6645 if (viscous) then
6646
6647# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6648#if defined(MFC_OpenACC)
6649# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6650!$acc loop seq
6651# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6652#elif defined(MFC_OpenMP)
6653# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6654
6655# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6656#endif
6657 do i = 1, 2
6658 re_l(i) = dflt_real
6659 re_r(i) = dflt_real
6660 if (re_size(i) > 0) re_l(i) = 0._wp
6661 if (re_size(i) > 0) re_r(i) = 0._wp
6662
6663# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6664#if defined(MFC_OpenACC)
6665# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6666!$acc loop seq
6667# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6668#elif defined(MFC_OpenMP)
6669# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6670
6671# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6672#endif
6673 do q = 1, re_size(i)
6674 re_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
6675 re_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, &
6676 & q) + re_r(i)
6677 end do
6678 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6679 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6680 end do
6681 end if
6682
6683 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
6684 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
6685
6686 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
6687 if (hypoelasticity) then
6688
6689# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6690#if defined(MFC_OpenACC)
6691# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6692!$acc loop seq
6693# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6694#elif defined(MFC_OpenMP)
6695# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6696
6697# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6698#endif
6699 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6700 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
6701 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
6702 end do
6703 g_l = 0._wp; g_r = 0._wp
6704
6705# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6706#if defined(MFC_OpenACC)
6707# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6708!$acc loop seq
6709# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6710#elif defined(MFC_OpenMP)
6711# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6712
6713# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6714#endif
6715 do i = 1, num_fluids
6716 g_l = g_l + alpha_l(i)*gs_rs(i)
6717 g_r = g_r + alpha_r(i)*gs_rs(i)
6718 end do
6719
6720# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6721#if defined(MFC_OpenACC)
6722# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6723!$acc loop seq
6724# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6725#elif defined(MFC_OpenMP)
6726# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6727
6728# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6729#endif
6730 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6731 ! Elastic contribution to energy if G large enough
6732 if ((g_l > verysmall) .and. (g_r > verysmall)) then
6733 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6734 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6735 ! Additional terms in 2D and 3D
6736 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
6737 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6738 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6739 end if
6740 end if
6741 end do
6742 end if
6743
6744 ! Hyperelastic stress contribution: strain energy added to total energy
6745 if (hyperelasticity) then
6746
6747# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6748#if defined(MFC_OpenACC)
6749# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6750!$acc loop seq
6751# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6752#elif defined(MFC_OpenMP)
6753# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6754
6755# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6756#endif
6757 do i = 1, num_dims
6758 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
6759 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
6760 end do
6761 g_l = 0._wp; g_r = 0._wp
6762
6763# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6764#if defined(MFC_OpenACC)
6765# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6766!$acc loop seq
6767# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6768#elif defined(MFC_OpenMP)
6769# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6770
6771# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6772#endif
6773 do i = 1, num_fluids
6774 ! Mixture left and right shear modulus
6775 g_l = g_l + alpha_l(i)*gs_rs(i)
6776 g_r = g_r + alpha_r(i)*gs_rs(i)
6777 end do
6778 ! Elastic contribution to energy if G large enough
6779 if (g_l > verysmall .and. g_r > verysmall) then
6780 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
6781 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%end + 1)
6782 end if
6783
6784# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6785#if defined(MFC_OpenACC)
6786# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6787!$acc loop seq
6788# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6789#elif defined(MFC_OpenMP)
6790# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6791
6792# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6793#endif
6794 do i = 1, b_size - 1
6795 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
6796 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
6797 end do
6798 end if
6799
6800 h_l = (e_l + pres_l)/rho_l
6801 h_r = (e_r + pres_r)/rho_r
6802
6803 if (avg_state == 1) then
6804# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6805 rho_avg = sqrt(rho_l*rho_r)
6806# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6807
6808# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6809 vel_avg_rms = 0._wp
6810# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6811
6812# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6813
6814# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6815#if defined(MFC_OpenACC)
6816# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6817!$acc loop seq
6818# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6819#elif defined(MFC_OpenMP)
6820# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6821
6822# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6823#endif
6824# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6825 do i = 1, num_vels
6826# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6827 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
6828# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6829 end do
6830# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6831
6832# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6833 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
6834# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6835
6836# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6837 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
6838# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6839
6840# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6841 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
6842# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6843
6844# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6845 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
6846# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6847
6848# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6849 if (chemistry) then
6850# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6851 eps = 0.001_wp
6852# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6853 call get_species_enthalpies_rt(t_l, h_il)
6854# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6855 call get_species_enthalpies_rt(t_r, h_ir)
6856# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6857 h_il = h_il*gas_constant/molecular_weights*t_l
6858# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6859 h_ir = h_ir*gas_constant/molecular_weights*t_r
6860# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6861 call get_species_specific_heats_r(t_l, cp_il)
6862# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6863 call get_species_specific_heats_r(t_r, cp_ir)
6864# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6865
6866# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6867 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
6868# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6869 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
6870# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6871 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
6872# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6873 if (abs(t_l - t_r) < eps) then
6874# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6875 ! Case when T_L and T_R are very close
6876# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6877 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
6878# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6879 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
6880# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6881 & - gas_constant/molecular_weights(:)))
6882# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6883 else
6884# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6885 ! Normal calculation when T_L and T_R are sufficiently different
6886# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6887 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
6888# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6889 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
6890# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6891 end if
6892# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6893 gamma_avg = cp_avg/cv_avg
6894# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6895
6896# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6897 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
6898# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6899 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
6900# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6901 end if
6902# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6903 end if
6904# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6905
6906# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6907 if (avg_state == 2) then
6908# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6909 rho_avg = 5.e-1_wp*(rho_l + rho_r)
6910# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6911 vel_avg_rms = 0._wp
6912# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6913
6914# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6915#if defined(MFC_OpenACC)
6916# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6917!$acc loop seq
6918# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6919#elif defined(MFC_OpenMP)
6920# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6921
6922# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6923#endif
6924# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6925 do i = 1, num_vels
6926# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6927 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
6928# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6929 end do
6930# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6931
6932# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6933 h_avg = 5.e-1_wp*(h_l + h_r)
6934# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6935 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
6936# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6937 qv_avg = 5.e-1_wp*(qv_l + qv_r)
6938# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6939 end if
6940
6941 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
6942 & c_l, qv_l)
6943
6944 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
6945 & c_r, qv_r)
6946
6947 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
6948 ! variables are placeholders to call the subroutine.
6949 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
6950 & 0._wp, c_avg, qv_avg)
6951
6952 if (viscous) then
6953
6954# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6955#if defined(MFC_OpenACC)
6956# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6957!$acc loop seq
6958# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6959#elif defined(MFC_OpenMP)
6960# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6961
6962# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6963#endif
6964 do i = 1, 2
6965 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
6966 end do
6967 end if
6968
6969 ! Low Mach correction
6970 if (low_mach == 2) then
6971 if (riemann_solver == 1 .or. riemann_solver == 5) then
6972# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6973 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6974# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6975 pcorr = 0._wp
6976# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6977
6978# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6979 if (low_mach == 1) then
6980# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6981 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
6982# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6983 end if
6984# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6985 else if (riemann_solver == 2) then
6986# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6987 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6988# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6989 pcorr = 0._wp
6990# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6991
6992# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6993 if (low_mach == 1) then
6994# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6995 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))) &
6996# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6997 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
6998# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6999 else if (low_mach == 2) then
7000# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7001 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))))
7002# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7003 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))))
7004# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7005 vel_l(dir_idx(1)) = vel_l_tmp
7006# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7007 vel_r(dir_idx(1)) = vel_r_tmp
7008# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7009 end if
7010# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7011 end if
7012 end if
7013
7014 ! COMPUTING THE DIRECT WAVE SPEEDS
7015 if (wave_speeds == 1) then
7016 if (elasticity) then
7017 ! Elastic wave speed, Rodriguez et al. JCP (2019)
7018 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) &
7019 & ))/rho_l), &
7020 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
7021 & + tau_e_r(dir_idx_tau(1)))/rho_r))
7022 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) &
7023 & ))/rho_r), &
7024 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
7025 & + tau_e_l(dir_idx_tau(1)))/rho_l))
7026 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
7027 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
7028 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
7029 & - vel_r(dir_idx(1))))
7030 else
7031 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7032 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7033 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7034 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
7035 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
7036 end if
7037 else if (wave_speeds == 2) then
7038 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7039
7040 pres_sr = pres_sl
7041
7042 ! Low Mach correction: Thornber et al. JCP (2008)
7043 ms_l = max(1._wp, &
7044 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
7045 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7046 ms_r = max(1._wp, &
7047 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
7048 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7049
7050 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7051 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7052
7053 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7054 end if
7055
7056 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7057 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7058
7059 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7060 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7061 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7062 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7063 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7064
7065 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7066 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
7067 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
7068
7069 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
7070 xi_mp = -min(0._wp, sign(1._wp, s_l))
7071 xi_pp = max(0._wp, sign(1._wp, s_r))
7072
7073 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 &
7074 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
7075 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
7076 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
7077 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
7078
7079 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))
7080
7081 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 &
7082 & - vel_r(dir_idx(1)))
7083
7084 ! Low Mach correction
7085 if (low_mach == 1) then
7086 if (riemann_solver == 1 .or. riemann_solver == 5) then
7087# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7088 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7089# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7090 pcorr = 0._wp
7091# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7092
7093# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7094 if (low_mach == 1) then
7095# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7096 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7097# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7098 end if
7099# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7100 else if (riemann_solver == 2) then
7101# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7102 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7103# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7104 pcorr = 0._wp
7105# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7106
7107# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7108 if (low_mach == 1) then
7109# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7110 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))) &
7111# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7112 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7113# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7114 else if (low_mach == 2) then
7115# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7116 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))))
7117# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7118 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))))
7119# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7120 vel_l(dir_idx(1)) = vel_l_tmp
7121# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7122 vel_r(dir_idx(1)) = vel_r_tmp
7123# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7124 end if
7125# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7126 end if
7127 else
7128 pcorr = 0._wp
7129 end if
7130
7131 ! COMPUTING FLUXES MASS FLUX.
7132
7133# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7134#if defined(MFC_OpenACC)
7135# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7136!$acc loop seq
7137# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7138#elif defined(MFC_OpenMP)
7139# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7140
7141# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7142#endif
7143 do i = 1, eqn_idx%cont%end
7144 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7145 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7146 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7147 end do
7148
7149 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7150
7151# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7152#if defined(MFC_OpenACC)
7153# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7154!$acc loop seq
7155# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7156#elif defined(MFC_OpenMP)
7157# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7158
7159# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7160#endif
7161 do i = 1, num_dims
7162 flux_rsx_vf(j, k, l, &
7163 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
7164 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
7165 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
7166 & *dir_flg(dir_idx(i))*pcorr
7167 end do
7168
7169 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
7170 flux_rsx_vf(j, k, l, eqn_idx%E) = (e_star + p_star)*vel_k_star + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
7171
7172 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
7173 if (elasticity) then
7174 flux_ene_e = 0._wp
7175
7176# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7177#if defined(MFC_OpenACC)
7178# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7179!$acc loop seq
7180# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7181#elif defined(MFC_OpenMP)
7182# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7183
7184# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7185#endif
7186 do i = 1, num_dims
7187 ! MOMENTUM ELASTIC FLUX.
7188 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
7189 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
7190 & - xi_p*tau_e_r(dir_idx_tau(i))
7191 ! ENERGY ELASTIC FLUX.
7192 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
7193 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
7194 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
7195 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
7196 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
7197 end do
7198 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
7199 end if
7200
7201 ! VOLUME FRACTION FLUX.
7202
7203# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7204#if defined(MFC_OpenACC)
7205# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7206!$acc loop seq
7207# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7208#elif defined(MFC_OpenMP)
7209# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7210
7211# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7212#endif
7213 do i = eqn_idx%adv%beg, eqn_idx%adv%end
7214 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7215 & i)*s_s + xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*s_s
7216 end do
7217
7218 ! Advection velocity source: interface velocity for volume fraction transport
7219
7220# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7221#if defined(MFC_OpenACC)
7222# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7223!$acc loop seq
7224# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7225#elif defined(MFC_OpenMP)
7226# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7227
7228# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7229#endif
7230 do i = 1, num_dims
7231 vel_src_rsx_vf(j, k, l, &
7232 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
7233 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
7234 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
7235 end do
7236
7237 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
7238 ! energy flux
7239
7240# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7241#if defined(MFC_OpenACC)
7242# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7243!$acc loop seq
7244# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7245#elif defined(MFC_OpenMP)
7246# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7247
7248# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7249#endif
7250 do i = 1, num_fluids
7251 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
7252 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
7253 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
7254 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
7255 & + pres_r)
7256
7257 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
7258 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7259 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
7260 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
7261 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7262 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
7263 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
7264 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7265 & i + eqn_idx%adv%beg - 1))
7266 end do
7267
7268 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7269
7270 ! HYPOELASTIC STRESS EVOLUTION FLUX.
7271 if (hypoelasticity) then
7272
7273# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7274#if defined(MFC_OpenACC)
7275# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7276!$acc loop seq
7277# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7278#elif defined(MFC_OpenMP)
7279# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7280
7281# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7282#endif
7283 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
7284 flux_rsx_vf(j, k, l, &
7285 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
7286 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
7287 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
7288 end do
7289 end if
7290
7291 ! Hyperelastic reference map flux for material deformation tracking
7292 if (hyperelasticity) then
7293
7294# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7295#if defined(MFC_OpenACC)
7296# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7297!$acc loop seq
7298# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7299#elif defined(MFC_OpenMP)
7300# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7301
7302# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7303#endif
7304 do i = 1, num_dims
7305 flux_rsx_vf(j, k, l, &
7306 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
7307 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
7308 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
7309 end do
7310 end if
7311
7312 ! COLOR FUNCTION FLUX
7313 if (surface_tension) then
7314 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
7315 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c))*s_s
7316 end if
7317
7318 ! Geometrical source flux for cylindrical coordinates
7319# 2178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7320# 2191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7321 end do
7322 end do
7323 end do
7324
7325# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7326#if defined(MFC_OpenACC)
7327# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7328!$acc end parallel loop
7329# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7330#elif defined(MFC_OpenMP)
7331# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7332
7333# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7334!$omp end target teams loop
7335# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7336#endif
7337 else if (model_eqns == 4) then
7338 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
7339
7340# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7341
7342# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7343#if defined(MFC_OpenACC)
7344# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7345!$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_L_m1, xi_R_m1, 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)
7346# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7347#elif defined(MFC_OpenMP)
7348# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7349
7350# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7351
7352# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7353
7354# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7355!$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_L_m1, xi_R_m1, 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)
7356# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7357#endif
7358# 2206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7359 do l = is3%beg, is3%end
7360 do k = is2%beg, is2%end
7361 do j = is1%beg, is1%end
7362 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7363 rho_l = 0._wp; rho_r = 0._wp
7364 gamma_l = 0._wp; gamma_r = 0._wp
7365 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7366 qv_l = 0._wp; qv_r = 0._wp
7367
7368
7369# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7370#if defined(MFC_OpenACC)
7371# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7372!$acc loop seq
7373# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7374#elif defined(MFC_OpenMP)
7375# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7376
7377# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7378#endif
7379 do i = 1, eqn_idx%cont%end
7380 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
7381 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
7382 end do
7383
7384
7385# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7386#if defined(MFC_OpenACC)
7387# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7388!$acc loop seq
7389# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7390#elif defined(MFC_OpenMP)
7391# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7392
7393# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7394#endif
7395 do i = 1, num_dims
7396 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7397 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
7398 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7399 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7400 end do
7401
7402
7403# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7404#if defined(MFC_OpenACC)
7405# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7406!$acc loop seq
7407# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7408#elif defined(MFC_OpenMP)
7409# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7410
7411# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7412#endif
7413 do i = 1, num_fluids
7414 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7415 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
7416 end do
7417
7418# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7419#if defined(MFC_OpenACC)
7420# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7421!$acc loop seq
7422# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7423#elif defined(MFC_OpenMP)
7424# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7425
7426# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7427#endif
7428 do i = 1, num_fluids
7429 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7430 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
7431 end do
7432
7433
7434# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7435#if defined(MFC_OpenACC)
7436# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7437!$acc loop seq
7438# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7439#elif defined(MFC_OpenMP)
7440# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7441
7442# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7443#endif
7444 do i = 1, num_fluids
7445 rho_l = rho_l + alpha_rho_l(i)
7446 gamma_l = gamma_l + alpha_l(i)*gammas(i)
7447 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
7448 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
7449
7450 rho_r = rho_r + alpha_rho_r(i)
7451 gamma_r = gamma_r + alpha_r(i)*gammas(i)
7452 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
7453 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
7454 end do
7455
7456 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7457 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
7458
7459 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
7460 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
7461
7462 h_l = (e_l + pres_l)/rho_l
7463 h_r = (e_r + pres_r)/rho_r
7464
7465 if (avg_state == 1) then
7466# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7467 rho_avg = sqrt(rho_l*rho_r)
7468# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7469
7470# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7471 vel_avg_rms = 0._wp
7472# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7473
7474# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7475
7476# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7477#if defined(MFC_OpenACC)
7478# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7479!$acc loop seq
7480# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7481#elif defined(MFC_OpenMP)
7482# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7483
7484# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7485#endif
7486# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7487 do i = 1, num_vels
7488# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7489 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
7490# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7491 end do
7492# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7493
7494# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7495 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
7496# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7497
7498# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7499 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
7500# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7501
7502# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7503 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
7504# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7505
7506# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7507 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
7508# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7509
7510# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7511 if (chemistry) then
7512# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7513 eps = 0.001_wp
7514# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7515 call get_species_enthalpies_rt(t_l, h_il)
7516# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7517 call get_species_enthalpies_rt(t_r, h_ir)
7518# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7519 h_il = h_il*gas_constant/molecular_weights*t_l
7520# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7521 h_ir = h_ir*gas_constant/molecular_weights*t_r
7522# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7523 call get_species_specific_heats_r(t_l, cp_il)
7524# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7525 call get_species_specific_heats_r(t_r, cp_ir)
7526# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7527
7528# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7529 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
7530# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7531 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
7532# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7533 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
7534# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7535 if (abs(t_l - t_r) < eps) then
7536# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7537 ! Case when T_L and T_R are very close
7538# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7539 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
7540# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7541 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
7542# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7543 & - gas_constant/molecular_weights(:)))
7544# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7545 else
7546# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7547 ! Normal calculation when T_L and T_R are sufficiently different
7548# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7549 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
7550# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7551 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
7552# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7553 end if
7554# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7555 gamma_avg = cp_avg/cv_avg
7556# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7557
7558# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7559 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
7560# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7561 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
7562# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7563 end if
7564# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7565 end if
7566# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7567
7568# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7569 if (avg_state == 2) then
7570# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7571 rho_avg = 5.e-1_wp*(rho_l + rho_r)
7572# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7573 vel_avg_rms = 0._wp
7574# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7575
7576# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7577#if defined(MFC_OpenACC)
7578# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7579!$acc loop seq
7580# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7581#elif defined(MFC_OpenMP)
7582# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7583
7584# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7585#endif
7586# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7587 do i = 1, num_vels
7588# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7589 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
7590# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7591 end do
7592# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7593
7594# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7595 h_avg = 5.e-1_wp*(h_l + h_r)
7596# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7597 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
7598# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7599 qv_avg = 5.e-1_wp*(qv_l + qv_r)
7600# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7601 end if
7602
7603 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
7604 & c_l, qv_l)
7605
7606 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
7607 & c_r, qv_r)
7608
7609 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
7610 ! variables are placeholders to call the subroutine.
7611
7612 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
7613 & 0._wp, c_avg, qv_avg)
7614
7615 if (wave_speeds == 1) then
7616 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7617 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7618
7619 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7620 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
7621 & - rho_r*(s_r - vel_r(dir_idx(1))))
7622 else if (wave_speeds == 2) then
7623 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7624
7625 pres_sr = pres_sl
7626
7627 ! Low Mach correction: Thornber et al. JCP (2008)
7628 ms_l = max(1._wp, &
7629 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
7630 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7631 ms_r = max(1._wp, &
7632 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
7633 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7634
7635 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7636 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7637
7638 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7639 end if
7640
7641 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7642 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7643
7644 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7645 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7646 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7647 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7648 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7649
7650 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7651 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
7652 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
7653
7654
7655# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7656#if defined(MFC_OpenACC)
7657# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7658!$acc loop seq
7659# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7660#elif defined(MFC_OpenMP)
7661# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7662
7663# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7664#endif
7665 do i = 1, eqn_idx%cont%end
7666 flux_rsx_vf(j, k, l, &
7667 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
7668 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7669 end do
7670
7671 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7672
7673# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7674#if defined(MFC_OpenACC)
7675# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7676!$acc loop seq
7677# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7678#elif defined(MFC_OpenMP)
7679# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7680
7681# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7682#endif
7683 do i = 1, num_dims
7684 flux_rsx_vf(j, k, l, &
7685 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
7686 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7687 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
7688 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
7689 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7690 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
7691 end do
7692
7693 if (bubbles_euler) then
7694 ! Put p_tilde in
7695
7696# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7697#if defined(MFC_OpenACC)
7698# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7699!$acc loop seq
7700# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7701#elif defined(MFC_OpenMP)
7702# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7703
7704# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7705#endif
7706 do i = 1, num_dims
7707 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
7708 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
7709 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
7710 end do
7711 end if
7712
7713 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
7714
7715
7716# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7717#if defined(MFC_OpenACC)
7718# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7719!$acc loop seq
7720# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7721#elif defined(MFC_OpenMP)
7722# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7723
7724# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7725#endif
7726 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
7727 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7728 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7729 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7730 end do
7731
7732 ! Advection velocity source: interface velocity for volume fraction transport
7733
7734# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7735#if defined(MFC_OpenACC)
7736# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7737!$acc loop seq
7738# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7739#elif defined(MFC_OpenMP)
7740# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7741
7742# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7743#endif
7744 do i = 1, num_dims
7745 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
7746 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
7747 end do
7748
7749 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7750
7751 ! Add advection flux for bubble variables
7752 if (bubbles_euler) then
7753
7754# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7755#if defined(MFC_OpenACC)
7756# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7757!$acc loop seq
7758# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7759#elif defined(MFC_OpenMP)
7760# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7761
7762# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7763#endif
7764 do i = eqn_idx%bub%beg, eqn_idx%bub%end
7765 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
7766 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7767 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, &
7768 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7769 end do
7770 end if
7771
7772 ! Geometrical source flux for cylindrical coordinates
7773
7774# 2397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7775# 2413 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7776 end do
7777 end do
7778 end do
7779
7780# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7781#if defined(MFC_OpenACC)
7782# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7783!$acc end parallel loop
7784# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7785#elif defined(MFC_OpenMP)
7786# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7787
7788# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7789!$omp end target teams loop
7790# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7791#endif
7792 else if (model_eqns == 2 .and. bubbles_euler) then
7793 ! 5-equation model with Euler-Euler bubble dynamics
7794
7795# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7796
7797# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7798#if defined(MFC_OpenACC)
7799# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7800!$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_L_m1, xi_R_m1, 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)
7801# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7802#elif defined(MFC_OpenMP)
7803# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7804
7805# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7806
7807# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7808
7809# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7810!$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_L_m1, xi_R_m1, 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)
7811# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7812#endif
7813# 2427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7814 do l = is3%beg, is3%end
7815 do k = is2%beg, is2%end
7816 do j = is1%beg, is1%end
7817 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7818 rho_l = 0._wp; rho_r = 0._wp
7819 gamma_l = 0._wp; gamma_r = 0._wp
7820 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7821 qv_l = 0._wp; qv_r = 0._wp
7822
7823
7824# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7825#if defined(MFC_OpenACC)
7826# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7827!$acc loop seq
7828# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7829#elif defined(MFC_OpenMP)
7830# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7831
7832# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7833#endif
7834 do i = 1, num_fluids
7835 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7836 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
7837 end do
7838
7839 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7840
7841
7842# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7843#if defined(MFC_OpenACC)
7844# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7845!$acc loop seq
7846# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7847#elif defined(MFC_OpenMP)
7848# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7849
7850# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7851#endif
7852 do i = 1, num_dims
7853 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7854 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
7855 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7856 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7857 end do
7858
7859 ! Retain this in the refactor
7860 if (mpp_lim .and. (num_fluids > 2)) then
7861
7862# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7863#if defined(MFC_OpenACC)
7864# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7865!$acc loop seq
7866# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7867#elif defined(MFC_OpenMP)
7868# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7869
7870# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7871#endif
7872 do i = 1, num_fluids
7873 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7874 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
7875 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
7876 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7877 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
7878 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
7879 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
7880 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
7881 end do
7882 else if (num_fluids > 2) then
7883
7884# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7885#if defined(MFC_OpenACC)
7886# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7887!$acc loop seq
7888# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7889#elif defined(MFC_OpenMP)
7890# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7891
7892# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7893#endif
7894 do i = 1, num_fluids - 1
7895 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7896 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
7897 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
7898 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7899 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
7900 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
7901 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
7902 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
7903 end do
7904 else
7905 rho_l = ql_prim_rsx_vf(j, k, l, 1)
7906 gamma_l = gammas(1)
7907 pi_inf_l = pi_infs(1)
7908 qv_l = qvs(1)
7909 rho_r = qr_prim_rsx_vf(j + 1, k, l, 1)
7910 gamma_r = gammas(1)
7911 pi_inf_r = pi_infs(1)
7912 qv_r = qvs(1)
7913 end if
7914
7915 if (viscous) then
7916 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
7917
7918# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7919#if defined(MFC_OpenACC)
7920# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7921!$acc loop seq
7922# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7923#elif defined(MFC_OpenMP)
7924# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7925
7926# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7927#endif
7928 do i = 1, 2
7929 re_l(i) = dflt_real
7930 re_r(i) = dflt_real
7931
7932 if (re_size(i) > 0) re_l(i) = 0._wp
7933 if (re_size(i) > 0) re_r(i) = 0._wp
7934
7935
7936# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7937#if defined(MFC_OpenACC)
7938# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7939!$acc loop seq
7940# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7941#elif defined(MFC_OpenMP)
7942# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7943
7944# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7945#endif
7946 do q = 1, re_size(i)
7947 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
7948 & q)))/res_gs(i, q) + re_l(i)
7949 re_r(i) = (1._wp - qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, &
7950 & q)))/res_gs(i, q) + re_r(i)
7951 end do
7952
7953 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
7954 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
7955 end do
7956 end if
7957 end if
7958
7959 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7960 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
7961
7962 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
7963 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
7964
7965 h_l = (e_l + pres_l)/rho_l
7966 h_r = (e_r + pres_r)/rho_r
7967
7968 if (avg_state == 2) then
7969
7970# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7971#if defined(MFC_OpenACC)
7972# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7973!$acc loop seq
7974# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7975#elif defined(MFC_OpenMP)
7976# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7977
7978# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7979#endif
7980 do i = 1, nb
7981 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
7982 r0_r(i) = qr_prim_rsx_vf(j + 1, k, l, rs(i))
7983
7984 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
7985 v0_r(i) = qr_prim_rsx_vf(j + 1, k, l, vs(i))
7986 if (.not. polytropic .and. .not. qbmm) then
7987 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
7988 p0_r(i) = qr_prim_rsx_vf(j + 1, k, l, ps(i))
7989 end if
7990 end do
7991
7992 if (.not. qbmm) then
7993 if (adv_n) then
7994 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
7995 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%n)
7996 else
7997 nbub_l = 0._wp
7998 nbub_r = 0._wp
7999
8000# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8001#if defined(MFC_OpenACC)
8002# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8003!$acc loop seq
8004# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8005#elif defined(MFC_OpenMP)
8006# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8007
8008# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8009#endif
8010 do i = 1, nb
8011 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
8012 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
8013 end do
8014
8015 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
8016 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j + 1, k, l, &
8017 & eqn_idx%E + num_fluids)/nbub_r
8018 end if
8019 else
8020 ! nb stored in 0th moment of first R0 bin in variable conversion module
8021 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
8022 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%bub%beg)
8023 end if
8024
8025
8026# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8027#if defined(MFC_OpenACC)
8028# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8029!$acc loop seq
8030# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8031#elif defined(MFC_OpenMP)
8032# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8033
8034# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8035#endif
8036 do i = 1, nb
8037 if (.not. qbmm) then
8038 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
8039 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
8040 end if
8041 end do
8042
8043 if (qbmm) then
8044 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
8045 pbwr3rbar = mom_sp_rsx_vf(j + 1, k, l, 4)
8046
8047 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
8048 r3rbar = mom_sp_rsx_vf(j + 1, k, l, 1)
8049
8050 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
8051 r3v2rbar = mom_sp_rsx_vf(j + 1, k, l, 3)
8052 else
8053 pbwr3lbar = 0._wp
8054 pbwr3rbar = 0._wp
8055
8056 r3lbar = 0._wp
8057 r3rbar = 0._wp
8058
8059 r3v2lbar = 0._wp
8060 r3v2rbar = 0._wp
8061
8062
8063# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8064#if defined(MFC_OpenACC)
8065# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8066!$acc loop seq
8067# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8068#elif defined(MFC_OpenMP)
8069# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8070
8071# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8072#endif
8073 do i = 1, nb
8074 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
8075 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
8076
8077 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
8078 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
8079
8080 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
8081 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
8082 end do
8083 end if
8084
8085 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8086 h_avg = 5.e-1_wp*(h_l + h_r)
8087 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8088 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8089 vel_avg_rms = 0._wp
8090
8091
8092# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8093#if defined(MFC_OpenACC)
8094# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8095!$acc loop seq
8096# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8097#elif defined(MFC_OpenMP)
8098# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8099
8100# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8101#endif
8102 do i = 1, num_dims
8103 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8104 end do
8105 end if
8106
8107 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
8108 & c_l, qv_l)
8109
8110 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
8111 & c_r, qv_r)
8112
8113 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8114 ! variables are placeholders to call the subroutine.
8115 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
8116 & 0._wp, c_avg, qv_avg)
8117
8118 if (viscous) then
8119
8120# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8121#if defined(MFC_OpenACC)
8122# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8123!$acc loop seq
8124# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8125#elif defined(MFC_OpenMP)
8126# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8127
8128# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8129#endif
8130 do i = 1, 2
8131 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
8132 end do
8133 end if
8134
8135 ! Low Mach correction
8136 if (low_mach == 2) then
8137 if (riemann_solver == 1 .or. riemann_solver == 5) then
8138# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8139 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8140# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8141 pcorr = 0._wp
8142# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8143
8144# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8145 if (low_mach == 1) then
8146# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8147 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8148# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8149 end if
8150# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8151 else if (riemann_solver == 2) then
8152# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8153 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8154# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8155 pcorr = 0._wp
8156# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8157
8158# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8159 if (low_mach == 1) then
8160# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8161 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))) &
8162# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8163 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8164# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8165 else if (low_mach == 2) then
8166# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8167 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))))
8168# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8169 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))))
8170# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8171 vel_l(dir_idx(1)) = vel_l_tmp
8172# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8173 vel_r(dir_idx(1)) = vel_r_tmp
8174# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8175 end if
8176# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8177 end if
8178 end if
8179
8180 if (wave_speeds == 1) then
8181 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
8182 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
8183
8184 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
8185 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
8186 & - rho_r*(s_r - vel_r(dir_idx(1))))
8187 else if (wave_speeds == 2) then
8188 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8189
8190 pres_sr = pres_sl
8191
8192 ! Low Mach correction: Thornber et al. JCP (2008)
8193 ms_l = max(1._wp, &
8194 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
8195 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
8196 ms_r = max(1._wp, &
8197 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
8198 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
8199
8200 s_l = vel_l(dir_idx(1)) - c_l*ms_l
8201 s_r = vel_r(dir_idx(1)) + c_r*ms_r
8202
8203 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
8204 end if
8205
8206 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
8207 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
8208
8209 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
8210 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8211 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8212 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8213 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8214
8215 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
8216 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
8217 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
8218
8219 ! Low Mach correction
8220 if (low_mach == 1) then
8221 if (riemann_solver == 1 .or. riemann_solver == 5) then
8222# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8223 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8224# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8225 pcorr = 0._wp
8226# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8227
8228# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8229 if (low_mach == 1) then
8230# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8231 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8232# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8233 end if
8234# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8235 else if (riemann_solver == 2) then
8236# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8237 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8238# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8239 pcorr = 0._wp
8240# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8241
8242# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8243 if (low_mach == 1) then
8244# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8245 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))) &
8246# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8247 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8248# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8249 else if (low_mach == 2) then
8250# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8251 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))))
8252# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8253 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))))
8254# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8255 vel_l(dir_idx(1)) = vel_l_tmp
8256# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8257 vel_r(dir_idx(1)) = vel_r_tmp
8258# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8259 end if
8260# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8261 end if
8262 else
8263 pcorr = 0._wp
8264 end if
8265
8266
8267# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8268#if defined(MFC_OpenACC)
8269# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8270!$acc loop seq
8271# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8272#elif defined(MFC_OpenMP)
8273# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8274
8275# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8276#endif
8277 do i = 1, eqn_idx%cont%end
8278 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8279 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
8280 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8281 end do
8282
8283 if (bubbles_euler .and. (num_fluids > 1)) then
8284 ! Kill mass transport @ gas density
8285 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
8286 end if
8287
8288 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
8289
8290 ! Include p_tilde
8291
8292 if (avg_state == 2) then
8293 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
8294 pres_l = pres_l - alpha_l(num_fluids)*pres_l
8295 else
8296 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
8297 end if
8298
8299 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
8300 pres_r = pres_r - alpha_r(num_fluids)*pres_r
8301 else
8302 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
8303 end if
8304 end if
8305
8306
8307# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8308#if defined(MFC_OpenACC)
8309# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8310!$acc loop seq
8311# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8312#elif defined(MFC_OpenMP)
8313# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8314
8315# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8316#endif
8317 do i = 1, num_dims
8318 flux_rsx_vf(j, k, l, &
8319 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
8320 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
8321 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
8322 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
8323 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
8324 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
8325 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
8326 end do
8327
8328 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
8329 flux_rsx_vf(j, k, l, &
8330 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
8331 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
8332 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
8333 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
8334 & *pcorr*s_s
8335
8336 ! Volume fraction flux
8337
8338# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8339#if defined(MFC_OpenACC)
8340# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8341!$acc loop seq
8342# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8343#elif defined(MFC_OpenMP)
8344# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8345
8346# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8347#endif
8348 do i = eqn_idx%adv%beg, eqn_idx%adv%end
8349 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8350 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
8351 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8352 end do
8353
8354 ! Advection velocity source: interface velocity for volume fraction transport
8355
8356# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8357#if defined(MFC_OpenACC)
8358# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8359!$acc loop seq
8360# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8361#elif defined(MFC_OpenMP)
8362# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8363
8364# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8365#endif
8366 do i = 1, num_dims
8367 vel_src_rsx_vf(j, k, l, &
8368 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
8369 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
8370
8371 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
8372 end do
8373
8374 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
8375
8376 ! Add advection flux for bubble variables
8377
8378# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8379#if defined(MFC_OpenACC)
8380# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8381!$acc loop seq
8382# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8383#elif defined(MFC_OpenMP)
8384# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8385
8386# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8387#endif
8388 do i = eqn_idx%bub%beg, eqn_idx%bub%end
8389 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
8390 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8391 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8392 end do
8393
8394 if (qbmm) then
8395 flux_rsx_vf(j, k, l, &
8396 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8397 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8398 end if
8399
8400 if (adv_n) then
8401 flux_rsx_vf(j, k, l, &
8402 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8403 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8404 end if
8405
8406 ! Geometrical source flux for cylindrical coordinates
8407# 2792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8408# 2809 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8409 end do
8410 end do
8411 end do
8412
8413# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8414#if defined(MFC_OpenACC)
8415# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8416!$acc end parallel loop
8417# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8418#elif defined(MFC_OpenMP)
8419# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8420
8421# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8422!$omp end target teams loop
8423# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8424#endif
8425 else
8426 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
8427
8428# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8429
8430# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8431#if defined(MFC_OpenACC)
8432# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8433!$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, xi_L_m1, xi_R_m1, 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)
8434# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8435#elif defined(MFC_OpenMP)
8436# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8437
8438# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8439
8440# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8441
8442# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8443!$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, xi_L_m1, xi_R_m1, 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)
8444# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8445#endif
8446# 2824 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8447 do l = is3%beg, is3%end
8448 do k = is2%beg, is2%end
8449 do j = is1%beg, is1%end
8450 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8451 rho_l = 0._wp; rho_r = 0._wp
8452 gamma_l = 0._wp; gamma_r = 0._wp
8453 pi_inf_l = 0._wp; pi_inf_r = 0._wp
8454 qv_l = 0._wp; qv_r = 0._wp
8455 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
8456
8457
8458# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8459#if defined(MFC_OpenACC)
8460# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8461!$acc loop seq
8462# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8463#elif defined(MFC_OpenMP)
8464# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8465
8466# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8467#endif
8468 do i = 1, num_fluids
8469 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8470 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
8471 end do
8472
8473
8474# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8475#if defined(MFC_OpenACC)
8476# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8477!$acc loop seq
8478# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8479#elif defined(MFC_OpenMP)
8480# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8481
8482# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8483#endif
8484 do i = 1, num_dims
8485 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
8486 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
8487 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
8488 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
8489 end do
8490
8491 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
8492 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
8493
8494 ! Change this by splitting it into the cases present in the bubbles_euler
8495 if (mpp_lim) then
8496
8497# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8498#if defined(MFC_OpenACC)
8499# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8500!$acc loop seq
8501# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8502#elif defined(MFC_OpenMP)
8503# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8504
8505# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8506#endif
8507 do i = 1, num_fluids
8508 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
8509 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
8510 & eqn_idx%E + i)), 1._wp)
8511 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
8512 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
8513 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
8514 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8515 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
8516 end do
8517
8518
8519# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8520#if defined(MFC_OpenACC)
8521# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8522!$acc loop seq
8523# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8524#elif defined(MFC_OpenMP)
8525# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8526
8527# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8528#endif
8529 do i = 1, num_fluids
8530 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
8531 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
8532 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
8533 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
8534 end do
8535 end if
8536
8537
8538# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8539#if defined(MFC_OpenACC)
8540# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8541!$acc loop seq
8542# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8543#elif defined(MFC_OpenMP)
8544# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8545
8546# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8547#endif
8548 do i = 1, num_fluids
8549 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
8550 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
8551 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
8552 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
8553
8554 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
8555 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
8556 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
8557 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
8558 end do
8559
8560 re_max = 0
8561 if (re_size(1) > 0) re_max = 1
8562 if (re_size(2) > 0) re_max = 2
8563
8564 if (viscous) then
8565
8566# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8567#if defined(MFC_OpenACC)
8568# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8569!$acc loop seq
8570# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8571#elif defined(MFC_OpenMP)
8572# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8573
8574# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8575#endif
8576 do i = 1, re_max
8577 re_l(i) = 0._wp
8578 re_r(i) = 0._wp
8579
8580
8581# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8582#if defined(MFC_OpenACC)
8583# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8584!$acc loop seq
8585# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8586#elif defined(MFC_OpenMP)
8587# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8588
8589# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8590#endif
8591 do q = 1, re_size(i)
8592 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
8593 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
8594 end do
8595
8596 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
8597 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
8598 end do
8599 end if
8600
8601 if (chemistry) then
8602 c_sum_yi_phi = 0.0_wp
8603
8604# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8605#if defined(MFC_OpenACC)
8606# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8607!$acc loop seq
8608# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8609#elif defined(MFC_OpenMP)
8610# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8611
8612# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8613#endif
8614 do i = eqn_idx%species%beg, eqn_idx%species%end
8615 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
8616 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
8617 end do
8618
8619 call get_mixture_molecular_weight(ys_l, mw_l)
8620 call get_mixture_molecular_weight(ys_r, mw_r)
8621
8622 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
8623 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
8624
8625 r_gas_l = gas_constant/mw_l
8626 r_gas_r = gas_constant/mw_r
8627
8628 t_l = pres_l/rho_l/r_gas_l
8629 t_r = pres_r/rho_r/r_gas_r
8630
8631 call get_species_specific_heats_r(t_l, cp_il)
8632 call get_species_specific_heats_r(t_r, cp_ir)
8633
8634 if (chem_params%gamma_method == 1) then
8635 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
8636 gamma_il = cp_il/(cp_il - 1.0_wp)
8637 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
8638
8639 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
8640 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
8641 else if (chem_params%gamma_method == 2) then
8642 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
8643 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
8644 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
8645 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
8646 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
8647
8648 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
8649 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
8650 end if
8651
8652 call get_mixture_energy_mass(t_l, ys_l, e_l)
8653 call get_mixture_energy_mass(t_r, ys_r, e_r)
8654
8655 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
8656 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
8657 h_l = (e_l + pres_l)/rho_l
8658 h_r = (e_r + pres_r)/rho_r
8659 else
8660 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
8661 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
8662
8663 h_l = (e_l + pres_l)/rho_l
8664 h_r = (e_r + pres_r)/rho_r
8665 end if
8666
8667 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
8668 if (hypoelasticity) then
8669
8670# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8671#if defined(MFC_OpenACC)
8672# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8673!$acc loop seq
8674# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8675#elif defined(MFC_OpenMP)
8676# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8677
8678# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8679#endif
8680 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
8681 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
8682 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
8683 end do
8684 g_l = 0._wp
8685 g_r = 0._wp
8686
8687# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8688#if defined(MFC_OpenACC)
8689# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8690!$acc loop seq
8691# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8692#elif defined(MFC_OpenMP)
8693# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8694
8695# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8696#endif
8697 do i = 1, num_fluids
8698 g_l = g_l + alpha_l(i)*gs_rs(i)
8699 g_r = g_r + alpha_r(i)*gs_rs(i)
8700 end do
8701
8702# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8703#if defined(MFC_OpenACC)
8704# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8705!$acc loop seq
8706# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8707#elif defined(MFC_OpenMP)
8708# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8709
8710# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8711#endif
8712 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
8713 ! Elastic contribution to energy if G large enough
8714 if ((g_l > verysmall) .and. (g_r > verysmall)) then
8715 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
8716 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
8717 ! Additional terms in 2D and 3D
8718 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
8719 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
8720 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
8721 end if
8722 end if
8723 end do
8724 end if
8725
8726 ! Hyperelastic stress contribution: strain energy added to total energy
8727 if (hyperelasticity) then
8728
8729# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8730#if defined(MFC_OpenACC)
8731# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8732!$acc loop seq
8733# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8734#elif defined(MFC_OpenMP)
8735# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8736
8737# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8738#endif
8739 do i = 1, num_dims
8740 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
8741 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
8742 end do
8743 g_l = 0._wp
8744 g_r = 0._wp
8745
8746# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8747#if defined(MFC_OpenACC)
8748# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8749!$acc loop seq
8750# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8751#elif defined(MFC_OpenMP)
8752# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8753
8754# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8755#endif
8756 do i = 1, num_fluids
8757 ! Mixture left and right shear modulus
8758 g_l = g_l + alpha_l(i)*gs_rs(i)
8759 g_r = g_r + alpha_r(i)*gs_rs(i)
8760 end do
8761 ! Elastic contribution to energy if G large enough
8762 if (g_l > verysmall .and. g_r > verysmall) then
8763 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
8764 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%end + 1)
8765 end if
8766
8767# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8768#if defined(MFC_OpenACC)
8769# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8770!$acc loop seq
8771# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8772#elif defined(MFC_OpenMP)
8773# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8774
8775# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8776#endif
8777 do i = 1, b_size - 1
8778 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
8779 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
8780 end do
8781 end if
8782
8783 h_l = (e_l + pres_l)/rho_l
8784 h_r = (e_r + pres_r)/rho_r
8785
8786 if (avg_state == 1) then
8787# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8788 rho_avg = sqrt(rho_l*rho_r)
8789# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8790
8791# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8792 vel_avg_rms = 0._wp
8793# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8794
8795# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8796
8797# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8798#if defined(MFC_OpenACC)
8799# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8800!$acc loop seq
8801# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8802#elif defined(MFC_OpenMP)
8803# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8804
8805# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8806#endif
8807# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8808 do i = 1, num_vels
8809# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8810 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
8811# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8812 end do
8813# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8814
8815# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8816 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
8817# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8818
8819# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8820 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
8821# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8822
8823# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8824 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
8825# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8826
8827# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8828 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
8829# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8830
8831# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8832 if (chemistry) then
8833# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8834 eps = 0.001_wp
8835# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8836 call get_species_enthalpies_rt(t_l, h_il)
8837# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8838 call get_species_enthalpies_rt(t_r, h_ir)
8839# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8840 h_il = h_il*gas_constant/molecular_weights*t_l
8841# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8842 h_ir = h_ir*gas_constant/molecular_weights*t_r
8843# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8844 call get_species_specific_heats_r(t_l, cp_il)
8845# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8846 call get_species_specific_heats_r(t_r, cp_ir)
8847# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8848
8849# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8850 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
8851# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8852 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
8853# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8854 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
8855# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8856 if (abs(t_l - t_r) < eps) then
8857# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8858 ! Case when T_L and T_R are very close
8859# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8860 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
8861# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8862 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
8863# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8864 & - gas_constant/molecular_weights(:)))
8865# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8866 else
8867# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8868 ! Normal calculation when T_L and T_R are sufficiently different
8869# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8870 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
8871# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8872 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
8873# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8874 end if
8875# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8876 gamma_avg = cp_avg/cv_avg
8877# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8878
8879# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8880 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
8881# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8882 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
8883# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8884 end if
8885# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8886 end if
8887# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8888
8889# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8890 if (avg_state == 2) then
8891# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8892 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8893# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8894 vel_avg_rms = 0._wp
8895# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8896
8897# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8898#if defined(MFC_OpenACC)
8899# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8900!$acc loop seq
8901# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8902#elif defined(MFC_OpenMP)
8903# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8904
8905# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8906#endif
8907# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8908 do i = 1, num_vels
8909# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8910 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8911# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8912 end do
8913# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8914
8915# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8916 h_avg = 5.e-1_wp*(h_l + h_r)
8917# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8918 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8919# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8920 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8921# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8922 end if
8923
8924 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
8925 & c_l, qv_l)
8926
8927 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
8928 & c_r, qv_r)
8929
8930 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8931 ! variables are placeholders to call the subroutine.
8932 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
8933 & c_sum_yi_phi, c_avg, qv_avg)
8934
8935 if (viscous) then
8936 if (chemistry) then
8937 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
8938 end if
8939
8940# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8941#if defined(MFC_OpenACC)
8942# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8943!$acc loop seq
8944# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8945#elif defined(MFC_OpenMP)
8946# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8947
8948# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8949#endif
8950 do i = 1, 2
8951 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
8952 end do
8953 end if
8954
8955 ! Low Mach correction
8956 if (low_mach == 2) then
8957 if (riemann_solver == 1 .or. riemann_solver == 5) then
8958# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8959 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8960# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8961 pcorr = 0._wp
8962# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8963
8964# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8965 if (low_mach == 1) then
8966# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8967 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8968# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8969 end if
8970# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8971 else if (riemann_solver == 2) then
8972# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8973 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8974# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8975 pcorr = 0._wp
8976# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8977
8978# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8979 if (low_mach == 1) then
8980# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8981 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))) &
8982# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8983 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8984# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8985 else if (low_mach == 2) then
8986# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8987 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))))
8988# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8989 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))))
8990# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8991 vel_l(dir_idx(1)) = vel_l_tmp
8992# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8993 vel_r(dir_idx(1)) = vel_r_tmp
8994# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8995 end if
8996# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8997 end if
8998 end if
8999
9000 if (wave_speeds == 1) then
9001 if (elasticity) then
9002 ! Elastic wave speed, Rodriguez et al. JCP (2019)
9003 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) &
9004 & ))/rho_l), &
9005 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
9006 & + tau_e_r(dir_idx_tau(1)))/rho_r))
9007 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) &
9008 & ))/rho_r), &
9009 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
9010 & + tau_e_l(dir_idx_tau(1)))/rho_l))
9011 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
9012 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
9013 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
9014 & - vel_r(dir_idx(1))))
9015 else
9016 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
9017 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
9018 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
9019 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
9020 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
9021 end if
9022 else if (wave_speeds == 2) then
9023 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9024
9025 pres_sr = pres_sl
9026
9027 ! Low Mach correction: Thornber et al. JCP (2008)
9028 ms_l = max(1._wp, &
9029 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
9030 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
9031 ms_r = max(1._wp, &
9032 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
9033 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
9034
9035 s_l = vel_l(dir_idx(1)) - c_l*ms_l
9036 s_r = vel_r(dir_idx(1)) + c_r*ms_r
9037
9038 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
9039 end if
9040
9041 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
9042 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
9043
9044 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
9045 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
9046 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
9047 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
9048 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
9049 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
9050
9051 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
9052 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
9053 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
9054
9055 ! Low Mach correction
9056 if (low_mach == 1) then
9057 if (riemann_solver == 1 .or. riemann_solver == 5) then
9058# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9059 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9060# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9061 pcorr = 0._wp
9062# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9063
9064# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9065 if (low_mach == 1) then
9066# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9067 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9068# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9069 end if
9070# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9071 else if (riemann_solver == 2) then
9072# 3108 "/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# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9075 pcorr = 0._wp
9076# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9077
9078# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9079 if (low_mach == 1) then
9080# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9081 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))) &
9082# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9083 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9084# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9085 else if (low_mach == 2) then
9086# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9087 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))))
9088# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9089 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))))
9090# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9091 vel_l(dir_idx(1)) = vel_l_tmp
9092# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9093 vel_r(dir_idx(1)) = vel_r_tmp
9094# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9095 end if
9096# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9097 end if
9098 else
9099 pcorr = 0._wp
9100 end if
9101
9102 ! COMPUTING THE HLLC FLUXES MASS FLUX.
9103
9104# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9105#if defined(MFC_OpenACC)
9106# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9107!$acc loop seq
9108# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9109#elif defined(MFC_OpenMP)
9110# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9111
9112# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9113#endif
9114 do i = 1, eqn_idx%cont%end
9115 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9116 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
9117 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9118 end do
9119
9120 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
9121 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
9122
9123# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9124#if defined(MFC_OpenACC)
9125# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9126!$acc loop seq
9127# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9128#elif defined(MFC_OpenMP)
9129# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9130
9131# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9132#endif
9133 do i = 1, num_dims
9134 flux_rsx_vf(j, k, l, &
9135 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
9136 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
9137 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
9138 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
9139 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
9140 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
9141 end do
9142
9143 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
9144 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
9145 flux_rsx_vf(j, k, l, &
9146 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 + xi_l*(s_s &
9147 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
9148 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
9149 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
9150 & *(s_p/s_r)*pcorr*s_s
9151
9152 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
9153 if (elasticity) then
9154 flux_ene_e = 0._wp
9155
9156# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9157#if defined(MFC_OpenACC)
9158# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9159!$acc loop seq
9160# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9161#elif defined(MFC_OpenMP)
9162# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9163
9164# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9165#endif
9166 do i = 1, num_dims
9167 ! MOMENTUM ELASTIC FLUX.
9168 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
9169 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
9170 & - xi_p*tau_e_r(dir_idx_tau(i))
9171 ! ENERGY ELASTIC FLUX.
9172 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
9173 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
9174 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
9175 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
9176 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
9177 end do
9178 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
9179 end if
9180
9181 ! HYPOELASTIC STRESS EVOLUTION FLUX.
9182 if (hypoelasticity) then
9183
9184# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9185#if defined(MFC_OpenACC)
9186# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9187!$acc loop seq
9188# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9189#elif defined(MFC_OpenMP)
9190# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9191
9192# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9193#endif
9194 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
9195 flux_rsx_vf(j, k, l, &
9196 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
9197 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
9198 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
9199 end do
9200 end if
9201
9202 ! VOLUME FRACTION FLUX.
9203
9204# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9205#if defined(MFC_OpenACC)
9206# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9207!$acc loop seq
9208# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9209#elif defined(MFC_OpenMP)
9210# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9211
9212# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9213#endif
9214 do i = eqn_idx%adv%beg, eqn_idx%adv%end
9215 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9216 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
9217 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9218 end do
9219
9220 ! VOLUME FRACTION SOURCE FLUX.
9221
9222# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9223#if defined(MFC_OpenACC)
9224# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9225!$acc loop seq
9226# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9227#elif defined(MFC_OpenMP)
9228# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9229
9230# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9231#endif
9232 do i = 1, num_dims
9233 vel_src_rsx_vf(j, k, l, &
9234 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
9235 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
9236 end do
9237
9238 ! COLOR FUNCTION FLUX
9239 if (surface_tension) then
9240 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
9241 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
9242 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9243 end if
9244
9245 ! Hyperelastic reference map flux for material deformation tracking
9246 if (hyperelasticity) then
9247
9248# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9249#if defined(MFC_OpenACC)
9250# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9251!$acc loop seq
9252# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9253#elif defined(MFC_OpenMP)
9254# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9255
9256# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9257#endif
9258 do i = 1, num_dims
9259 flux_rsx_vf(j, k, l, &
9260 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
9261 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
9262 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
9263 end do
9264 end if
9265
9266 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
9267
9268 if (chemistry) then
9269
9270# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9271#if defined(MFC_OpenACC)
9272# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9273!$acc loop seq
9274# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9275#elif defined(MFC_OpenMP)
9276# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9277
9278# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9279#endif
9280 do i = eqn_idx%species%beg, eqn_idx%species%end
9281 y_l = ql_prim_rsx_vf(j, k, l, i)
9282 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
9283
9284 flux_rsx_vf(j, k, l, &
9285 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
9286 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9287 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
9288 end do
9289 end if
9290
9291 ! Geometrical source flux for cylindrical coordinates
9292# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9293# 3262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9294 end do
9295 end do
9296 end do
9297
9298# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9299#if defined(MFC_OpenACC)
9300# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9301!$acc end parallel loop
9302# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9303#elif defined(MFC_OpenMP)
9304# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9305
9306# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9307!$omp end target teams loop
9308# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9309#endif
9310 end if
9311 end if
9312# 1776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9313# 1777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9314# 1778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9315 if (norm_dir == 2) then
9316 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
9317 if (model_eqns == 3) then
9318 ! 6-equation model (model_eqns=3): separate phasic internal energies
9319
9320# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9321
9322# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9323#if defined(MFC_OpenACC)
9324# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9325!$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_L_m1, xi_R_m1, xi_MP, xi_PP)
9326# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9327#elif defined(MFC_OpenMP)
9328# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9329
9330# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9331
9332# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9333
9334# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9335!$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_L_m1, xi_R_m1, xi_MP, xi_PP)
9336# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9337#endif
9338# 1792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9339 do l = is3%beg, is3%end
9340 do k = is1%beg, is1%end
9341 do j = is2%beg, is2%end
9342 vel_l_rms = 0._wp; vel_r_rms = 0._wp
9343 rho_l = 0._wp; rho_r = 0._wp
9344 gamma_l = 0._wp; gamma_r = 0._wp
9345 pi_inf_l = 0._wp; pi_inf_r = 0._wp
9346 qv_l = 0._wp; qv_r = 0._wp
9347 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
9348
9349
9350# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9351#if defined(MFC_OpenACC)
9352# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9353!$acc loop seq
9354# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9355#elif defined(MFC_OpenMP)
9356# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9357
9358# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9359#endif
9360 do i = 1, num_dims
9361 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
9362 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
9363 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
9364 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
9365 end do
9366
9367 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
9368 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
9369
9370 rho_l = 0._wp
9371 gamma_l = 0._wp
9372 pi_inf_l = 0._wp
9373 qv_l = 0._wp
9374
9375 rho_r = 0._wp
9376 gamma_r = 0._wp
9377 pi_inf_r = 0._wp
9378 qv_r = 0._wp
9379
9380 alpha_l_sum = 0._wp
9381 alpha_r_sum = 0._wp
9382
9383 if (mpp_lim) then
9384
9385# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9386#if defined(MFC_OpenACC)
9387# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9388!$acc loop seq
9389# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9390#elif defined(MFC_OpenMP)
9391# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9392
9393# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9394#endif
9395 do i = 1, num_fluids
9396 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
9397 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
9398 & eqn_idx%E + i)), 1._wp)
9399 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
9400 end do
9401
9402
9403# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9404#if defined(MFC_OpenACC)
9405# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9406!$acc loop seq
9407# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9408#elif defined(MFC_OpenMP)
9409# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9410
9411# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9412#endif
9413 do i = 1, num_fluids
9414 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
9415 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
9416 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
9417 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
9418 end do
9419
9420
9421# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9422#if defined(MFC_OpenACC)
9423# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9424!$acc loop seq
9425# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9426#elif defined(MFC_OpenMP)
9427# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9428
9429# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9430#endif
9431 do i = 1, num_fluids
9432 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
9433 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
9434 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
9435 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
9436 end do
9437 end if
9438
9439
9440# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9441#if defined(MFC_OpenACC)
9442# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9443!$acc loop seq
9444# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9445#elif defined(MFC_OpenMP)
9446# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9447
9448# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9449#endif
9450 do i = 1, num_fluids
9451 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
9452 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
9453 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
9454 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
9455
9456 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
9457 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
9458 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
9459 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
9460
9461 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
9462 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%adv%beg + i - 1)
9463 end do
9464
9465 if (viscous) then
9466
9467# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9468#if defined(MFC_OpenACC)
9469# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9470!$acc loop seq
9471# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9472#elif defined(MFC_OpenMP)
9473# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9474
9475# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9476#endif
9477 do i = 1, 2
9478 re_l(i) = dflt_real
9479 re_r(i) = dflt_real
9480 if (re_size(i) > 0) re_l(i) = 0._wp
9481 if (re_size(i) > 0) re_r(i) = 0._wp
9482
9483# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9484#if defined(MFC_OpenACC)
9485# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9486!$acc loop seq
9487# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9488#elif defined(MFC_OpenMP)
9489# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9490
9491# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9492#endif
9493 do q = 1, re_size(i)
9494 re_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
9495 re_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + re_idx(i, q))/res_gs(i, &
9496 & q) + re_r(i)
9497 end do
9498 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
9499 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
9500 end do
9501 end if
9502
9503 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
9504 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
9505
9506 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
9507 if (hypoelasticity) then
9508
9509# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9510#if defined(MFC_OpenACC)
9511# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9512!$acc loop seq
9513# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9514#elif defined(MFC_OpenMP)
9515# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9516
9517# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9518#endif
9519 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
9520 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
9521 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
9522 end do
9523 g_l = 0._wp; g_r = 0._wp
9524
9525# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9526#if defined(MFC_OpenACC)
9527# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9528!$acc loop seq
9529# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9530#elif defined(MFC_OpenMP)
9531# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9532
9533# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9534#endif
9535 do i = 1, num_fluids
9536 g_l = g_l + alpha_l(i)*gs_rs(i)
9537 g_r = g_r + alpha_r(i)*gs_rs(i)
9538 end do
9539
9540# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9541#if defined(MFC_OpenACC)
9542# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9543!$acc loop seq
9544# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9545#elif defined(MFC_OpenMP)
9546# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9547
9548# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9549#endif
9550 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
9551 ! Elastic contribution to energy if G large enough
9552 if ((g_l > verysmall) .and. (g_r > verysmall)) then
9553 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
9554 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
9555 ! Additional terms in 2D and 3D
9556 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
9557 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
9558 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
9559 end if
9560 end if
9561 end do
9562 end if
9563
9564 ! Hyperelastic stress contribution: strain energy added to total energy
9565 if (hyperelasticity) then
9566
9567# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9568#if defined(MFC_OpenACC)
9569# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9570!$acc loop seq
9571# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9572#elif defined(MFC_OpenMP)
9573# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9574
9575# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9576#endif
9577 do i = 1, num_dims
9578 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
9579 xi_field_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%beg - 1 + i)
9580 end do
9581 g_l = 0._wp; g_r = 0._wp
9582
9583# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9584#if defined(MFC_OpenACC)
9585# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9586!$acc loop seq
9587# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9588#elif defined(MFC_OpenMP)
9589# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9590
9591# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9592#endif
9593 do i = 1, num_fluids
9594 ! Mixture left and right shear modulus
9595 g_l = g_l + alpha_l(i)*gs_rs(i)
9596 g_r = g_r + alpha_r(i)*gs_rs(i)
9597 end do
9598 ! Elastic contribution to energy if G large enough
9599 if (g_l > verysmall .and. g_r > verysmall) then
9600 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
9601 e_r = e_r + g_r*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%end + 1)
9602 end if
9603
9604# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9605#if defined(MFC_OpenACC)
9606# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9607!$acc loop seq
9608# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9609#elif defined(MFC_OpenMP)
9610# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9611
9612# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9613#endif
9614 do i = 1, b_size - 1
9615 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
9616 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
9617 end do
9618 end if
9619
9620 h_l = (e_l + pres_l)/rho_l
9621 h_r = (e_r + pres_r)/rho_r
9622
9623 if (avg_state == 1) then
9624# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9625 rho_avg = sqrt(rho_l*rho_r)
9626# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9627
9628# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9629 vel_avg_rms = 0._wp
9630# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9631
9632# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9633
9634# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9635#if defined(MFC_OpenACC)
9636# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9637!$acc loop seq
9638# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9639#elif defined(MFC_OpenMP)
9640# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9641
9642# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9643#endif
9644# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9645 do i = 1, num_vels
9646# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9647 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
9648# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9649 end do
9650# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9651
9652# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9653 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
9654# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9655
9656# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9657 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
9658# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9659
9660# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9661 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
9662# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9663
9664# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9665 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
9666# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9667
9668# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9669 if (chemistry) then
9670# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9671 eps = 0.001_wp
9672# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9673 call get_species_enthalpies_rt(t_l, h_il)
9674# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9675 call get_species_enthalpies_rt(t_r, h_ir)
9676# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9677 h_il = h_il*gas_constant/molecular_weights*t_l
9678# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9679 h_ir = h_ir*gas_constant/molecular_weights*t_r
9680# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9681 call get_species_specific_heats_r(t_l, cp_il)
9682# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9683 call get_species_specific_heats_r(t_r, cp_ir)
9684# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9685
9686# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9687 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
9688# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9689 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
9690# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9691 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
9692# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9693 if (abs(t_l - t_r) < eps) then
9694# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9695 ! Case when T_L and T_R are very close
9696# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9697 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
9698# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9699 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
9700# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9701 & - gas_constant/molecular_weights(:)))
9702# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9703 else
9704# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9705 ! Normal calculation when T_L and T_R are sufficiently different
9706# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9707 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
9708# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9709 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
9710# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9711 end if
9712# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9713 gamma_avg = cp_avg/cv_avg
9714# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9715
9716# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9717 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
9718# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9719 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
9720# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9721 end if
9722# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9723 end if
9724# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9725
9726# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9727 if (avg_state == 2) then
9728# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9729 rho_avg = 5.e-1_wp*(rho_l + rho_r)
9730# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9731 vel_avg_rms = 0._wp
9732# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9733
9734# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9735#if defined(MFC_OpenACC)
9736# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9737!$acc loop seq
9738# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9739#elif defined(MFC_OpenMP)
9740# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9741
9742# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9743#endif
9744# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9745 do i = 1, num_vels
9746# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9747 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
9748# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9749 end do
9750# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9751
9752# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9753 h_avg = 5.e-1_wp*(h_l + h_r)
9754# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9755 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
9756# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9757 qv_avg = 5.e-1_wp*(qv_l + qv_r)
9758# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9759 end if
9760
9761 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
9762 & c_l, qv_l)
9763
9764 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
9765 & c_r, qv_r)
9766
9767 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
9768 ! variables are placeholders to call the subroutine.
9769 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
9770 & 0._wp, c_avg, qv_avg)
9771
9772 if (viscous) then
9773
9774# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9775#if defined(MFC_OpenACC)
9776# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9777!$acc loop seq
9778# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9779#elif defined(MFC_OpenMP)
9780# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9781
9782# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9783#endif
9784 do i = 1, 2
9785 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
9786 end do
9787 end if
9788
9789 ! Low Mach correction
9790 if (low_mach == 2) then
9791 if (riemann_solver == 1 .or. riemann_solver == 5) then
9792# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9793 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9794# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9795 pcorr = 0._wp
9796# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9797
9798# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9799 if (low_mach == 1) then
9800# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9801 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9802# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9803 end if
9804# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9805 else if (riemann_solver == 2) then
9806# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9807 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9808# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9809 pcorr = 0._wp
9810# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9811
9812# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9813 if (low_mach == 1) then
9814# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9815 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))) &
9816# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9817 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9818# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9819 else if (low_mach == 2) then
9820# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9821 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))))
9822# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9823 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))))
9824# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9825 vel_l(dir_idx(1)) = vel_l_tmp
9826# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9827 vel_r(dir_idx(1)) = vel_r_tmp
9828# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9829 end if
9830# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9831 end if
9832 end if
9833
9834 ! COMPUTING THE DIRECT WAVE SPEEDS
9835 if (wave_speeds == 1) then
9836 if (elasticity) then
9837 ! Elastic wave speed, Rodriguez et al. JCP (2019)
9838 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) &
9839 & ))/rho_l), &
9840 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
9841 & + tau_e_r(dir_idx_tau(1)))/rho_r))
9842 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) &
9843 & ))/rho_r), &
9844 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
9845 & + tau_e_l(dir_idx_tau(1)))/rho_l))
9846 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
9847 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
9848 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
9849 & - vel_r(dir_idx(1))))
9850 else
9851 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
9852 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
9853 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
9854 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
9855 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
9856 end if
9857 else if (wave_speeds == 2) then
9858 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9859
9860 pres_sr = pres_sl
9861
9862 ! Low Mach correction: Thornber et al. JCP (2008)
9863 ms_l = max(1._wp, &
9864 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
9865 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
9866 ms_r = max(1._wp, &
9867 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
9868 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
9869
9870 s_l = vel_l(dir_idx(1)) - c_l*ms_l
9871 s_r = vel_r(dir_idx(1)) + c_r*ms_r
9872
9873 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
9874 end if
9875
9876 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
9877 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
9878
9879 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
9880 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
9881 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
9882 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
9883 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
9884
9885 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
9886 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
9887 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
9888
9889 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
9890 xi_mp = -min(0._wp, sign(1._wp, s_l))
9891 xi_pp = max(0._wp, sign(1._wp, s_r))
9892
9893 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 &
9894 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
9895 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
9896 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
9897 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
9898
9899 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))
9900
9901 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 &
9902 & - vel_r(dir_idx(1)))
9903
9904 ! Low Mach correction
9905 if (low_mach == 1) then
9906 if (riemann_solver == 1 .or. riemann_solver == 5) then
9907# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9908 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9909# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9910 pcorr = 0._wp
9911# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9912
9913# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9914 if (low_mach == 1) then
9915# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9916 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9917# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9918 end if
9919# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9920 else if (riemann_solver == 2) then
9921# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9922 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9923# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9924 pcorr = 0._wp
9925# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9926
9927# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9928 if (low_mach == 1) then
9929# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9930 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))) &
9931# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9932 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9933# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9934 else if (low_mach == 2) then
9935# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9936 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))))
9937# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9938 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))))
9939# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9940 vel_l(dir_idx(1)) = vel_l_tmp
9941# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9942 vel_r(dir_idx(1)) = vel_r_tmp
9943# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9944 end if
9945# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9946 end if
9947 else
9948 pcorr = 0._wp
9949 end if
9950
9951 ! COMPUTING FLUXES MASS FLUX.
9952
9953# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9954#if defined(MFC_OpenACC)
9955# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9956!$acc loop seq
9957# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9958#elif defined(MFC_OpenMP)
9959# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9960
9961# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9962#endif
9963 do i = 1, eqn_idx%cont%end
9964 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9965 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
9966 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9967 end do
9968
9969 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
9970
9971# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9972#if defined(MFC_OpenACC)
9973# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9974!$acc loop seq
9975# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9976#elif defined(MFC_OpenMP)
9977# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9978
9979# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9980#endif
9981 do i = 1, num_dims
9982 flux_rsx_vf(j, k, l, &
9983 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
9984 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
9985 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
9986 & *dir_flg(dir_idx(i))*pcorr
9987 end do
9988
9989 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
9990 flux_rsx_vf(j, k, l, eqn_idx%E) = (e_star + p_star)*vel_k_star + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
9991
9992 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
9993 if (elasticity) then
9994 flux_ene_e = 0._wp
9995
9996# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9997#if defined(MFC_OpenACC)
9998# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9999!$acc loop seq
10000# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10001#elif defined(MFC_OpenMP)
10002# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10003
10004# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10005#endif
10006 do i = 1, num_dims
10007 ! MOMENTUM ELASTIC FLUX.
10008 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
10009 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
10010 & - xi_p*tau_e_r(dir_idx_tau(i))
10011 ! ENERGY ELASTIC FLUX.
10012 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
10013 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
10014 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
10015 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
10016 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
10017 end do
10018 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
10019 end if
10020
10021 ! VOLUME FRACTION FLUX.
10022
10023# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10024#if defined(MFC_OpenACC)
10025# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10026!$acc loop seq
10027# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10028#elif defined(MFC_OpenMP)
10029# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10030
10031# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10032#endif
10033 do i = eqn_idx%adv%beg, eqn_idx%adv%end
10034 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
10035 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k + 1, l, i)*s_s
10036 end do
10037
10038 ! Advection velocity source: interface velocity for volume fraction transport
10039
10040# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10041#if defined(MFC_OpenACC)
10042# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10043!$acc loop seq
10044# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10045#elif defined(MFC_OpenMP)
10046# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10047
10048# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10049#endif
10050 do i = 1, num_dims
10051 vel_src_rsx_vf(j, k, l, &
10052 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
10053 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
10054 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
10055 end do
10056
10057 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
10058 ! energy flux
10059
10060# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10061#if defined(MFC_OpenACC)
10062# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10063!$acc loop seq
10064# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10065#elif defined(MFC_OpenMP)
10066# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10067
10068# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10069#endif
10070 do i = 1, num_fluids
10071 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
10072 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
10073 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
10074 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
10075 & + pres_r)
10076
10077 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
10078 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
10079 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
10080 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
10081 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
10082 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
10083 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
10084 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
10085 & i + eqn_idx%adv%beg - 1))
10086 end do
10087
10088 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
10089
10090 ! HYPOELASTIC STRESS EVOLUTION FLUX.
10091 if (hypoelasticity) then
10092
10093# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10094#if defined(MFC_OpenACC)
10095# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10096!$acc loop seq
10097# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10098#elif defined(MFC_OpenMP)
10099# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10100
10101# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10102#endif
10103 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
10104 flux_rsx_vf(j, k, l, &
10105 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
10106 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
10107 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
10108 end do
10109 end if
10110
10111 ! Hyperelastic reference map flux for material deformation tracking
10112 if (hyperelasticity) then
10113
10114# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10115#if defined(MFC_OpenACC)
10116# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10117!$acc loop seq
10118# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10119#elif defined(MFC_OpenMP)
10120# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10121
10122# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10123#endif
10124 do i = 1, num_dims
10125 flux_rsx_vf(j, k, l, &
10126 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
10127 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
10128 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
10129 end do
10130 end if
10131
10132 ! COLOR FUNCTION FLUX
10133 if (surface_tension) then
10134 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
10135 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%c))*s_s
10136 end if
10137
10138 ! Geometrical source flux for cylindrical coordinates
10139# 2157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10140 if (cyl_coord) then
10141 ! Substituting the advective flux into the inviscid geometrical source flux
10142
10143# 2159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10144#if defined(MFC_OpenACC)
10145# 2159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10146!$acc loop seq
10147# 2159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10148#elif defined(MFC_OpenMP)
10149# 2159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10150
10151# 2159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10152#endif
10153 do i = 1, eqn_idx%E
10154 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
10155 end do
10156
10157# 2163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10158#if defined(MFC_OpenACC)
10159# 2163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10160!$acc loop seq
10161# 2163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10162#elif defined(MFC_OpenMP)
10163# 2163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10164
10165# 2163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10166#endif
10167 do i = eqn_idx%int_en%beg, eqn_idx%int_en%end
10168 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
10169 end do
10170 ! Recalculating the radial momentum geometric source flux
10171 flux_gsrc_rsx_vf(j, k, l, &
10172 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
10173 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
10174 ! Geometrical source of the void fraction(s) is zero
10175
10176# 2172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10177#if defined(MFC_OpenACC)
10178# 2172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10179!$acc loop seq
10180# 2172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10181#elif defined(MFC_OpenMP)
10182# 2172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10183
10184# 2172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10185#endif
10186 do i = eqn_idx%adv%beg, eqn_idx%adv%end
10187 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
10188 end do
10189 end if
10190# 2178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10191# 2191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10192 end do
10193 end do
10194 end do
10195
10196# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10197#if defined(MFC_OpenACC)
10198# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10199!$acc end parallel loop
10200# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10201#elif defined(MFC_OpenMP)
10202# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10203
10204# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10205!$omp end target teams loop
10206# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10207#endif
10208 else if (model_eqns == 4) then
10209 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
10210
10211# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10212
10213# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10214#if defined(MFC_OpenACC)
10215# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10216!$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_L_m1, xi_R_m1, 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)
10217# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10218#elif defined(MFC_OpenMP)
10219# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10220
10221# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10222
10223# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10224
10225# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10226!$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_L_m1, xi_R_m1, 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)
10227# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10228#endif
10229# 2206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10230 do l = is3%beg, is3%end
10231 do k = is1%beg, is1%end
10232 do j = is2%beg, is2%end
10233 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10234 rho_l = 0._wp; rho_r = 0._wp
10235 gamma_l = 0._wp; gamma_r = 0._wp
10236 pi_inf_l = 0._wp; pi_inf_r = 0._wp
10237 qv_l = 0._wp; qv_r = 0._wp
10238
10239
10240# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10241#if defined(MFC_OpenACC)
10242# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10243!$acc loop seq
10244# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10245#elif defined(MFC_OpenMP)
10246# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10247
10248# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10249#endif
10250 do i = 1, eqn_idx%cont%end
10251 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
10252 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
10253 end do
10254
10255
10256# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10257#if defined(MFC_OpenACC)
10258# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10259!$acc loop seq
10260# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10261#elif defined(MFC_OpenMP)
10262# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10263
10264# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10265#endif
10266 do i = 1, num_dims
10267 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
10268 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
10269 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
10270 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
10271 end do
10272
10273
10274# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10275#if defined(MFC_OpenACC)
10276# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10277!$acc loop seq
10278# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10279#elif defined(MFC_OpenMP)
10280# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10281
10282# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10283#endif
10284 do i = 1, num_fluids
10285 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
10286 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
10287 end do
10288
10289# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10290#if defined(MFC_OpenACC)
10291# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10292!$acc loop seq
10293# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10294#elif defined(MFC_OpenMP)
10295# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10296
10297# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10298#endif
10299 do i = 1, num_fluids
10300 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
10301 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
10302 end do
10303
10304
10305# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10306#if defined(MFC_OpenACC)
10307# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10308!$acc loop seq
10309# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10310#elif defined(MFC_OpenMP)
10311# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10312
10313# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10314#endif
10315 do i = 1, num_fluids
10316 rho_l = rho_l + alpha_rho_l(i)
10317 gamma_l = gamma_l + alpha_l(i)*gammas(i)
10318 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
10319 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
10320
10321 rho_r = rho_r + alpha_rho_r(i)
10322 gamma_r = gamma_r + alpha_r(i)*gammas(i)
10323 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
10324 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
10325 end do
10326
10327 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
10328 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
10329
10330 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
10331 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
10332
10333 h_l = (e_l + pres_l)/rho_l
10334 h_r = (e_r + pres_r)/rho_r
10335
10336 if (avg_state == 1) then
10337# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10338 rho_avg = sqrt(rho_l*rho_r)
10339# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10340
10341# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10342 vel_avg_rms = 0._wp
10343# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10344
10345# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10346
10347# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10348#if defined(MFC_OpenACC)
10349# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10350!$acc loop seq
10351# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10352#elif defined(MFC_OpenMP)
10353# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10354
10355# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10356#endif
10357# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10358 do i = 1, num_vels
10359# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10360 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
10361# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10362 end do
10363# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10364
10365# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10366 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
10367# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10368
10369# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10370 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
10371# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10372
10373# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10374 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
10375# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10376
10377# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10378 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
10379# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10380
10381# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10382 if (chemistry) then
10383# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10384 eps = 0.001_wp
10385# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10386 call get_species_enthalpies_rt(t_l, h_il)
10387# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10388 call get_species_enthalpies_rt(t_r, h_ir)
10389# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10390 h_il = h_il*gas_constant/molecular_weights*t_l
10391# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10392 h_ir = h_ir*gas_constant/molecular_weights*t_r
10393# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10394 call get_species_specific_heats_r(t_l, cp_il)
10395# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10396 call get_species_specific_heats_r(t_r, cp_ir)
10397# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10398
10399# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10400 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
10401# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10402 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
10403# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10404 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
10405# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10406 if (abs(t_l - t_r) < eps) then
10407# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10408 ! Case when T_L and T_R are very close
10409# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10410 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
10411# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10412 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
10413# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10414 & - gas_constant/molecular_weights(:)))
10415# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10416 else
10417# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10418 ! Normal calculation when T_L and T_R are sufficiently different
10419# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10420 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
10421# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10422 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
10423# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10424 end if
10425# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10426 gamma_avg = cp_avg/cv_avg
10427# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10428
10429# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10430 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
10431# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10432 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
10433# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10434 end if
10435# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10436 end if
10437# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10438
10439# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10440 if (avg_state == 2) then
10441# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10442 rho_avg = 5.e-1_wp*(rho_l + rho_r)
10443# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10444 vel_avg_rms = 0._wp
10445# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10446
10447# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10448#if defined(MFC_OpenACC)
10449# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10450!$acc loop seq
10451# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10452#elif defined(MFC_OpenMP)
10453# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10454
10455# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10456#endif
10457# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10458 do i = 1, num_vels
10459# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10460 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
10461# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10462 end do
10463# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10464
10465# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10466 h_avg = 5.e-1_wp*(h_l + h_r)
10467# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10468 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
10469# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10470 qv_avg = 5.e-1_wp*(qv_l + qv_r)
10471# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10472 end if
10473
10474 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
10475 & c_l, qv_l)
10476
10477 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
10478 & c_r, qv_r)
10479
10480 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
10481 ! variables are placeholders to call the subroutine.
10482
10483 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
10484 & 0._wp, c_avg, qv_avg)
10485
10486 if (wave_speeds == 1) then
10487 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
10488 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
10489
10490 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
10491 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
10492 & - rho_r*(s_r - vel_r(dir_idx(1))))
10493 else if (wave_speeds == 2) then
10494 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
10495
10496 pres_sr = pres_sl
10497
10498 ! Low Mach correction: Thornber et al. JCP (2008)
10499 ms_l = max(1._wp, &
10500 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
10501 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
10502 ms_r = max(1._wp, &
10503 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
10504 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
10505
10506 s_l = vel_l(dir_idx(1)) - c_l*ms_l
10507 s_r = vel_r(dir_idx(1)) + c_r*ms_r
10508
10509 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
10510 end if
10511
10512 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
10513 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
10514
10515 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
10516 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
10517 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
10518 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
10519 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
10520
10521 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
10522 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
10523 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
10524
10525
10526# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10527#if defined(MFC_OpenACC)
10528# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10529!$acc loop seq
10530# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10531#elif defined(MFC_OpenMP)
10532# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10533
10534# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10535#endif
10536 do i = 1, eqn_idx%cont%end
10537 flux_rsx_vf(j, k, l, &
10538 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
10539 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
10540 end do
10541
10542 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
10543
10544# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10545#if defined(MFC_OpenACC)
10546# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10547!$acc loop seq
10548# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10549#elif defined(MFC_OpenMP)
10550# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10551
10552# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10553#endif
10554 do i = 1, num_dims
10555 flux_rsx_vf(j, k, l, &
10556 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
10557 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
10558 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
10559 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
10560 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
10561 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
10562 end do
10563
10564 if (bubbles_euler) then
10565 ! Put p_tilde in
10566
10567# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10568#if defined(MFC_OpenACC)
10569# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10570!$acc loop seq
10571# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10572#elif defined(MFC_OpenMP)
10573# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10574
10575# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10576#endif
10577 do i = 1, num_dims
10578 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
10579 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
10580 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
10581 end do
10582 end if
10583
10584 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
10585
10586
10587# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10588#if defined(MFC_OpenACC)
10589# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10590!$acc loop seq
10591# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10592#elif defined(MFC_OpenMP)
10593# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10594
10595# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10596#endif
10597 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
10598 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
10599 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
10600 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
10601 end do
10602
10603 ! Advection velocity source: interface velocity for volume fraction transport
10604
10605# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10606#if defined(MFC_OpenACC)
10607# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10608!$acc loop seq
10609# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10610#elif defined(MFC_OpenMP)
10611# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10612
10613# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10614#endif
10615 do i = 1, num_dims
10616 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
10617 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
10618 end do
10619
10620 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
10621
10622 ! Add advection flux for bubble variables
10623 if (bubbles_euler) then
10624
10625# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10626#if defined(MFC_OpenACC)
10627# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10628!$acc loop seq
10629# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10630#elif defined(MFC_OpenMP)
10631# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10632
10633# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10634#endif
10635 do i = eqn_idx%bub%beg, eqn_idx%bub%end
10636 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
10637 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
10638 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k + 1, l, &
10639 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
10640 end do
10641 end if
10642
10643 ! Geometrical source flux for cylindrical coordinates
10644
10645# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10646 if (cyl_coord) then
10647 ! Substituting the advective flux into the inviscid geometrical source flux
10648
10649# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10650#if defined(MFC_OpenACC)
10651# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10652!$acc loop seq
10653# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10654#elif defined(MFC_OpenMP)
10655# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10656
10657# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10658#endif
10659 do i = 1, eqn_idx%E
10660 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
10661 end do
10662 ! Recalculating the radial momentum geometric source flux
10663 flux_gsrc_rsx_vf(j, k, l, &
10664 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
10665 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
10666 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
10667 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
10668 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
10669 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
10670 ! Geometrical source of the void fraction(s) is zero
10671
10672# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10673#if defined(MFC_OpenACC)
10674# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10675!$acc loop seq
10676# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10677#elif defined(MFC_OpenMP)
10678# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10679
10680# 2391 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10681#endif
10682 do i = eqn_idx%adv%beg, eqn_idx%adv%end
10683 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
10684 end do
10685 end if
10686# 2397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10687# 2413 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10688 end do
10689 end do
10690 end do
10691
10692# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10693#if defined(MFC_OpenACC)
10694# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10695!$acc end parallel loop
10696# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10697#elif defined(MFC_OpenMP)
10698# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10699
10700# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10701!$omp end target teams loop
10702# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10703#endif
10704 else if (model_eqns == 2 .and. bubbles_euler) then
10705 ! 5-equation model with Euler-Euler bubble dynamics
10706
10707# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10708
10709# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10710#if defined(MFC_OpenACC)
10711# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10712!$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_L_m1, xi_R_m1, 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)
10713# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10714#elif defined(MFC_OpenMP)
10715# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10716
10717# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10718
10719# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10720
10721# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10722!$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_L_m1, xi_R_m1, 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)
10723# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10724#endif
10725# 2427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10726 do l = is3%beg, is3%end
10727 do k = is1%beg, is1%end
10728 do j = is2%beg, is2%end
10729 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10730 rho_l = 0._wp; rho_r = 0._wp
10731 gamma_l = 0._wp; gamma_r = 0._wp
10732 pi_inf_l = 0._wp; pi_inf_r = 0._wp
10733 qv_l = 0._wp; qv_r = 0._wp
10734
10735
10736# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10737#if defined(MFC_OpenACC)
10738# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10739!$acc loop seq
10740# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10741#elif defined(MFC_OpenMP)
10742# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10743
10744# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10745#endif
10746 do i = 1, num_fluids
10747 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
10748 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
10749 end do
10750
10751 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10752
10753
10754# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10755#if defined(MFC_OpenACC)
10756# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10757!$acc loop seq
10758# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10759#elif defined(MFC_OpenMP)
10760# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10761
10762# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10763#endif
10764 do i = 1, num_dims
10765 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
10766 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
10767 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
10768 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
10769 end do
10770
10771 ! Retain this in the refactor
10772 if (mpp_lim .and. (num_fluids > 2)) then
10773
10774# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10775#if defined(MFC_OpenACC)
10776# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10777!$acc loop seq
10778# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10779#elif defined(MFC_OpenMP)
10780# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10781
10782# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10783#endif
10784 do i = 1, num_fluids
10785 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
10786 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
10787 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
10788 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
10789 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
10790 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
10791 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
10792 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
10793 end do
10794 else if (num_fluids > 2) then
10795
10796# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10797#if defined(MFC_OpenACC)
10798# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10799!$acc loop seq
10800# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10801#elif defined(MFC_OpenMP)
10802# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10803
10804# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10805#endif
10806 do i = 1, num_fluids - 1
10807 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
10808 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
10809 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
10810 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
10811 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
10812 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
10813 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
10814 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
10815 end do
10816 else
10817 rho_l = ql_prim_rsx_vf(j, k, l, 1)
10818 gamma_l = gammas(1)
10819 pi_inf_l = pi_infs(1)
10820 qv_l = qvs(1)
10821 rho_r = qr_prim_rsx_vf(j, k + 1, l, 1)
10822 gamma_r = gammas(1)
10823 pi_inf_r = pi_infs(1)
10824 qv_r = qvs(1)
10825 end if
10826
10827 if (viscous) then
10828 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
10829
10830# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10831#if defined(MFC_OpenACC)
10832# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10833!$acc loop seq
10834# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10835#elif defined(MFC_OpenMP)
10836# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10837
10838# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10839#endif
10840 do i = 1, 2
10841 re_l(i) = dflt_real
10842 re_r(i) = dflt_real
10843
10844 if (re_size(i) > 0) re_l(i) = 0._wp
10845 if (re_size(i) > 0) re_r(i) = 0._wp
10846
10847
10848# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10849#if defined(MFC_OpenACC)
10850# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10851!$acc loop seq
10852# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10853#elif defined(MFC_OpenMP)
10854# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10855
10856# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10857#endif
10858 do q = 1, re_size(i)
10859 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
10860 & q)))/res_gs(i, q) + re_l(i)
10861 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + re_idx(i, &
10862 & q)))/res_gs(i, q) + re_r(i)
10863 end do
10864
10865 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
10866 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
10867 end do
10868 end if
10869 end if
10870
10871 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
10872 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
10873
10874 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
10875 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
10876
10877 h_l = (e_l + pres_l)/rho_l
10878 h_r = (e_r + pres_r)/rho_r
10879
10880 if (avg_state == 2) then
10881
10882# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10883#if defined(MFC_OpenACC)
10884# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10885!$acc loop seq
10886# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10887#elif defined(MFC_OpenMP)
10888# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10889
10890# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10891#endif
10892 do i = 1, nb
10893 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
10894 r0_r(i) = qr_prim_rsx_vf(j, k + 1, l, rs(i))
10895
10896 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
10897 v0_r(i) = qr_prim_rsx_vf(j, k + 1, l, vs(i))
10898 if (.not. polytropic .and. .not. qbmm) then
10899 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
10900 p0_r(i) = qr_prim_rsx_vf(j, k + 1, l, ps(i))
10901 end if
10902 end do
10903
10904 if (.not. qbmm) then
10905 if (adv_n) then
10906 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
10907 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%n)
10908 else
10909 nbub_l = 0._wp
10910 nbub_r = 0._wp
10911
10912# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10913#if defined(MFC_OpenACC)
10914# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10915!$acc loop seq
10916# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10917#elif defined(MFC_OpenMP)
10918# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10919
10920# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10921#endif
10922 do i = 1, nb
10923 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
10924 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
10925 end do
10926
10927 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
10928 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k + 1, l, &
10929 & eqn_idx%E + num_fluids)/nbub_r
10930 end if
10931 else
10932 ! nb stored in 0th moment of first R0 bin in variable conversion module
10933 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
10934 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%bub%beg)
10935 end if
10936
10937
10938# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10939#if defined(MFC_OpenACC)
10940# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10941!$acc loop seq
10942# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10943#elif defined(MFC_OpenMP)
10944# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10945
10946# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10947#endif
10948 do i = 1, nb
10949 if (.not. qbmm) then
10950 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
10951 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
10952 end if
10953 end do
10954
10955 if (qbmm) then
10956 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
10957 pbwr3rbar = mom_sp_rsx_vf(j, k + 1, l, 4)
10958
10959 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
10960 r3rbar = mom_sp_rsx_vf(j, k + 1, l, 1)
10961
10962 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
10963 r3v2rbar = mom_sp_rsx_vf(j, k + 1, l, 3)
10964 else
10965 pbwr3lbar = 0._wp
10966 pbwr3rbar = 0._wp
10967
10968 r3lbar = 0._wp
10969 r3rbar = 0._wp
10970
10971 r3v2lbar = 0._wp
10972 r3v2rbar = 0._wp
10973
10974
10975# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10976#if defined(MFC_OpenACC)
10977# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10978!$acc loop seq
10979# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10980#elif defined(MFC_OpenMP)
10981# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10982
10983# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10984#endif
10985 do i = 1, nb
10986 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
10987 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
10988
10989 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
10990 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
10991
10992 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
10993 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
10994 end do
10995 end if
10996
10997 rho_avg = 5.e-1_wp*(rho_l + rho_r)
10998 h_avg = 5.e-1_wp*(h_l + h_r)
10999 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
11000 qv_avg = 5.e-1_wp*(qv_l + qv_r)
11001 vel_avg_rms = 0._wp
11002
11003
11004# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11005#if defined(MFC_OpenACC)
11006# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11007!$acc loop seq
11008# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11009#elif defined(MFC_OpenMP)
11010# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11011
11012# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11013#endif
11014 do i = 1, num_dims
11015 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
11016 end do
11017 end if
11018
11019 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
11020 & c_l, qv_l)
11021
11022 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
11023 & c_r, qv_r)
11024
11025 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
11026 ! variables are placeholders to call the subroutine.
11027 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
11028 & 0._wp, c_avg, qv_avg)
11029
11030 if (viscous) then
11031
11032# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11033#if defined(MFC_OpenACC)
11034# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11035!$acc loop seq
11036# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11037#elif defined(MFC_OpenMP)
11038# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11039
11040# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11041#endif
11042 do i = 1, 2
11043 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
11044 end do
11045 end if
11046
11047 ! Low Mach correction
11048 if (low_mach == 2) then
11049 if (riemann_solver == 1 .or. riemann_solver == 5) then
11050# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11051 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11052# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11053 pcorr = 0._wp
11054# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11055
11056# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11057 if (low_mach == 1) then
11058# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11059 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
11060# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11061 end if
11062# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11063 else if (riemann_solver == 2) then
11064# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11065 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11066# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11067 pcorr = 0._wp
11068# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11069
11070# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11071 if (low_mach == 1) then
11072# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11073 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))) &
11074# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11075 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
11076# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11077 else if (low_mach == 2) then
11078# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11079 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))))
11080# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11081 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))))
11082# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11083 vel_l(dir_idx(1)) = vel_l_tmp
11084# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11085 vel_r(dir_idx(1)) = vel_r_tmp
11086# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11087 end if
11088# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11089 end if
11090 end if
11091
11092 if (wave_speeds == 1) then
11093 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
11094 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
11095
11096 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
11097 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
11098 & - rho_r*(s_r - vel_r(dir_idx(1))))
11099 else if (wave_speeds == 2) then
11100 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
11101
11102 pres_sr = pres_sl
11103
11104 ! Low Mach correction: Thornber et al. JCP (2008)
11105 ms_l = max(1._wp, &
11106 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
11107 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
11108 ms_r = max(1._wp, &
11109 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
11110 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
11111
11112 s_l = vel_l(dir_idx(1)) - c_l*ms_l
11113 s_r = vel_r(dir_idx(1)) + c_r*ms_r
11114
11115 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
11116 end if
11117
11118 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
11119 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
11120
11121 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
11122 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
11123 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
11124 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
11125 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
11126
11127 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
11128 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
11129 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
11130
11131 ! Low Mach correction
11132 if (low_mach == 1) then
11133 if (riemann_solver == 1 .or. riemann_solver == 5) then
11134# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11135 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11136# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11137 pcorr = 0._wp
11138# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11139
11140# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11141 if (low_mach == 1) then
11142# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11143 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
11144# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11145 end if
11146# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11147 else if (riemann_solver == 2) then
11148# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11149 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11150# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11151 pcorr = 0._wp
11152# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11153
11154# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11155 if (low_mach == 1) then
11156# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11157 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))) &
11158# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11159 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
11160# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11161 else if (low_mach == 2) then
11162# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11163 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))))
11164# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11165 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))))
11166# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11167 vel_l(dir_idx(1)) = vel_l_tmp
11168# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11169 vel_r(dir_idx(1)) = vel_r_tmp
11170# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11171 end if
11172# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11173 end if
11174 else
11175 pcorr = 0._wp
11176 end if
11177
11178
11179# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11180#if defined(MFC_OpenACC)
11181# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11182!$acc loop seq
11183# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11184#elif defined(MFC_OpenMP)
11185# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11186
11187# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11188#endif
11189 do i = 1, eqn_idx%cont%end
11190 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
11191 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
11192 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
11193 end do
11194
11195 if (bubbles_euler .and. (num_fluids > 1)) then
11196 ! Kill mass transport @ gas density
11197 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
11198 end if
11199
11200 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
11201
11202 ! Include p_tilde
11203
11204 if (avg_state == 2) then
11205 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
11206 pres_l = pres_l - alpha_l(num_fluids)*pres_l
11207 else
11208 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
11209 end if
11210
11211 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
11212 pres_r = pres_r - alpha_r(num_fluids)*pres_r
11213 else
11214 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
11215 end if
11216 end if
11217
11218
11219# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11220#if defined(MFC_OpenACC)
11221# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11222!$acc loop seq
11223# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11224#elif defined(MFC_OpenMP)
11225# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11226
11227# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11228#endif
11229 do i = 1, num_dims
11230 flux_rsx_vf(j, k, l, &
11231 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
11232 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
11233 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
11234 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
11235 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
11236 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
11237 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
11238 end do
11239
11240 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
11241 flux_rsx_vf(j, k, l, &
11242 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
11243 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
11244 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
11245 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
11246 & *pcorr*s_s
11247
11248 ! Volume fraction flux
11249
11250# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11251#if defined(MFC_OpenACC)
11252# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11253!$acc loop seq
11254# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11255#elif defined(MFC_OpenMP)
11256# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11257
11258# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11259#endif
11260 do i = eqn_idx%adv%beg, eqn_idx%adv%end
11261 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
11262 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
11263 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
11264 end do
11265
11266 ! Advection velocity source: interface velocity for volume fraction transport
11267
11268# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11269#if defined(MFC_OpenACC)
11270# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11271!$acc loop seq
11272# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11273#elif defined(MFC_OpenMP)
11274# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11275
11276# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11277#endif
11278 do i = 1, num_dims
11279 vel_src_rsx_vf(j, k, l, &
11280 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
11281 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
11282
11283 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
11284 end do
11285
11286 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
11287
11288 ! Add advection flux for bubble variables
11289
11290# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11291#if defined(MFC_OpenACC)
11292# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11293!$acc loop seq
11294# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11295#elif defined(MFC_OpenMP)
11296# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11297
11298# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11299#endif
11300 do i = eqn_idx%bub%beg, eqn_idx%bub%end
11301 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
11302 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
11303 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k + 1, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
11304 end do
11305
11306 if (qbmm) then
11307 flux_rsx_vf(j, k, l, &
11308 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
11309 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
11310 end if
11311
11312 if (adv_n) then
11313 flux_rsx_vf(j, k, l, &
11314 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
11315 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
11316 end if
11317
11318 ! Geometrical source flux for cylindrical coordinates
11319# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11320 if (cyl_coord) then
11321 ! Substituting the advective flux into the inviscid geometrical source flux
11322
11323# 2773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11324#if defined(MFC_OpenACC)
11325# 2773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11326!$acc loop seq
11327# 2773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11328#elif defined(MFC_OpenMP)
11329# 2773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11330
11331# 2773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11332#endif
11333 do i = 1, eqn_idx%E
11334 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
11335 end do
11336 ! Recalculating the radial momentum geometric source flux
11337 flux_gsrc_rsx_vf(j, k, l, &
11338 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
11339 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
11340 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
11341 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
11342 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
11343 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
11344 ! Geometrical source of the void fraction(s) is zero
11345
11346# 2786 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11347#if defined(MFC_OpenACC)
11348# 2786 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11349!$acc loop seq
11350# 2786 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11351#elif defined(MFC_OpenMP)
11352# 2786 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11353
11354# 2786 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11355#endif
11356 do i = eqn_idx%adv%beg, eqn_idx%adv%end
11357 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
11358 end do
11359 end if
11360# 2792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11361# 2809 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11362 end do
11363 end do
11364 end do
11365
11366# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11367#if defined(MFC_OpenACC)
11368# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11369!$acc end parallel loop
11370# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11371#elif defined(MFC_OpenMP)
11372# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11373
11374# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11375!$omp end target teams loop
11376# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11377#endif
11378 else
11379 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
11380
11381# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11382
11383# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11384#if defined(MFC_OpenACC)
11385# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11386!$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, xi_L_m1, xi_R_m1, 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)
11387# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11388#elif defined(MFC_OpenMP)
11389# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11390
11391# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11392
11393# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11394
11395# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11396!$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, xi_L_m1, xi_R_m1, 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)
11397# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11398#endif
11399# 2824 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11400 do l = is3%beg, is3%end
11401 do k = is1%beg, is1%end
11402 do j = is2%beg, is2%end
11403 vel_l_rms = 0._wp; vel_r_rms = 0._wp
11404 rho_l = 0._wp; rho_r = 0._wp
11405 gamma_l = 0._wp; gamma_r = 0._wp
11406 pi_inf_l = 0._wp; pi_inf_r = 0._wp
11407 qv_l = 0._wp; qv_r = 0._wp
11408 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
11409
11410
11411# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11412#if defined(MFC_OpenACC)
11413# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11414!$acc loop seq
11415# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11416#elif defined(MFC_OpenMP)
11417# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11418
11419# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11420#endif
11421 do i = 1, num_fluids
11422 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
11423 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
11424 end do
11425
11426
11427# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11428#if defined(MFC_OpenACC)
11429# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11430!$acc loop seq
11431# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11432#elif defined(MFC_OpenMP)
11433# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11434
11435# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11436#endif
11437 do i = 1, num_dims
11438 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
11439 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
11440 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
11441 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
11442 end do
11443
11444 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
11445 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
11446
11447 ! Change this by splitting it into the cases present in the bubbles_euler
11448 if (mpp_lim) then
11449
11450# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11451#if defined(MFC_OpenACC)
11452# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11453!$acc loop seq
11454# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11455#elif defined(MFC_OpenMP)
11456# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11457
11458# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11459#endif
11460 do i = 1, num_fluids
11461 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
11462 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
11463 & eqn_idx%E + i)), 1._wp)
11464 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
11465 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
11466 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
11467 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
11468 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
11469 end do
11470
11471
11472# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11473#if defined(MFC_OpenACC)
11474# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11475!$acc loop seq
11476# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11477#elif defined(MFC_OpenMP)
11478# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11479
11480# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11481#endif
11482 do i = 1, num_fluids
11483 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
11484 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
11485 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
11486 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
11487 end do
11488 end if
11489
11490
11491# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11492#if defined(MFC_OpenACC)
11493# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11494!$acc loop seq
11495# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11496#elif defined(MFC_OpenMP)
11497# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11498
11499# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11500#endif
11501 do i = 1, num_fluids
11502 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
11503 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
11504 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
11505 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
11506
11507 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
11508 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
11509 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
11510 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
11511 end do
11512
11513 re_max = 0
11514 if (re_size(1) > 0) re_max = 1
11515 if (re_size(2) > 0) re_max = 2
11516
11517 if (viscous) then
11518
11519# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11520#if defined(MFC_OpenACC)
11521# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11522!$acc loop seq
11523# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11524#elif defined(MFC_OpenMP)
11525# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11526
11527# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11528#endif
11529 do i = 1, re_max
11530 re_l(i) = 0._wp
11531 re_r(i) = 0._wp
11532
11533
11534# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11535#if defined(MFC_OpenACC)
11536# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11537!$acc loop seq
11538# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11539#elif defined(MFC_OpenMP)
11540# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11541
11542# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11543#endif
11544 do q = 1, re_size(i)
11545 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
11546 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
11547 end do
11548
11549 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
11550 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
11551 end do
11552 end if
11553
11554 if (chemistry) then
11555 c_sum_yi_phi = 0.0_wp
11556
11557# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11558#if defined(MFC_OpenACC)
11559# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11560!$acc loop seq
11561# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11562#elif defined(MFC_OpenMP)
11563# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11564
11565# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11566#endif
11567 do i = eqn_idx%species%beg, eqn_idx%species%end
11568 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
11569 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
11570 end do
11571
11572 call get_mixture_molecular_weight(ys_l, mw_l)
11573 call get_mixture_molecular_weight(ys_r, mw_r)
11574
11575 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
11576 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
11577
11578 r_gas_l = gas_constant/mw_l
11579 r_gas_r = gas_constant/mw_r
11580
11581 t_l = pres_l/rho_l/r_gas_l
11582 t_r = pres_r/rho_r/r_gas_r
11583
11584 call get_species_specific_heats_r(t_l, cp_il)
11585 call get_species_specific_heats_r(t_r, cp_ir)
11586
11587 if (chem_params%gamma_method == 1) then
11588 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
11589 gamma_il = cp_il/(cp_il - 1.0_wp)
11590 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
11591
11592 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
11593 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
11594 else if (chem_params%gamma_method == 2) then
11595 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
11596 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
11597 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
11598 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
11599 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
11600
11601 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
11602 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
11603 end if
11604
11605 call get_mixture_energy_mass(t_l, ys_l, e_l)
11606 call get_mixture_energy_mass(t_r, ys_r, e_r)
11607
11608 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
11609 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
11610 h_l = (e_l + pres_l)/rho_l
11611 h_r = (e_r + pres_r)/rho_r
11612 else
11613 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
11614 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
11615
11616 h_l = (e_l + pres_l)/rho_l
11617 h_r = (e_r + pres_r)/rho_r
11618 end if
11619
11620 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
11621 if (hypoelasticity) then
11622
11623# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11624#if defined(MFC_OpenACC)
11625# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11626!$acc loop seq
11627# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11628#elif defined(MFC_OpenMP)
11629# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11630
11631# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11632#endif
11633 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
11634 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
11635 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
11636 end do
11637 g_l = 0._wp
11638 g_r = 0._wp
11639
11640# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11641#if defined(MFC_OpenACC)
11642# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11643!$acc loop seq
11644# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11645#elif defined(MFC_OpenMP)
11646# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11647
11648# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11649#endif
11650 do i = 1, num_fluids
11651 g_l = g_l + alpha_l(i)*gs_rs(i)
11652 g_r = g_r + alpha_r(i)*gs_rs(i)
11653 end do
11654
11655# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11656#if defined(MFC_OpenACC)
11657# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11658!$acc loop seq
11659# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11660#elif defined(MFC_OpenMP)
11661# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11662
11663# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11664#endif
11665 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
11666 ! Elastic contribution to energy if G large enough
11667 if ((g_l > verysmall) .and. (g_r > verysmall)) then
11668 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
11669 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
11670 ! Additional terms in 2D and 3D
11671 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
11672 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
11673 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
11674 end if
11675 end if
11676 end do
11677 end if
11678
11679 ! Hyperelastic stress contribution: strain energy added to total energy
11680 if (hyperelasticity) then
11681
11682# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11683#if defined(MFC_OpenACC)
11684# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11685!$acc loop seq
11686# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11687#elif defined(MFC_OpenMP)
11688# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11689
11690# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11691#endif
11692 do i = 1, num_dims
11693 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
11694 xi_field_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%beg - 1 + i)
11695 end do
11696 g_l = 0._wp
11697 g_r = 0._wp
11698
11699# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11700#if defined(MFC_OpenACC)
11701# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11702!$acc loop seq
11703# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11704#elif defined(MFC_OpenMP)
11705# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11706
11707# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11708#endif
11709 do i = 1, num_fluids
11710 ! Mixture left and right shear modulus
11711 g_l = g_l + alpha_l(i)*gs_rs(i)
11712 g_r = g_r + alpha_r(i)*gs_rs(i)
11713 end do
11714 ! Elastic contribution to energy if G large enough
11715 if (g_l > verysmall .and. g_r > verysmall) then
11716 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
11717 e_r = e_r + g_r*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%end + 1)
11718 end if
11719
11720# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11721#if defined(MFC_OpenACC)
11722# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11723!$acc loop seq
11724# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11725#elif defined(MFC_OpenMP)
11726# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11727
11728# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11729#endif
11730 do i = 1, b_size - 1
11731 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
11732 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
11733 end do
11734 end if
11735
11736 h_l = (e_l + pres_l)/rho_l
11737 h_r = (e_r + pres_r)/rho_r
11738
11739 if (avg_state == 1) then
11740# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11741 rho_avg = sqrt(rho_l*rho_r)
11742# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11743
11744# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11745 vel_avg_rms = 0._wp
11746# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11747
11748# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11749
11750# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11751#if defined(MFC_OpenACC)
11752# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11753!$acc loop seq
11754# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11755#elif defined(MFC_OpenMP)
11756# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11757
11758# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11759#endif
11760# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11761 do i = 1, num_vels
11762# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11763 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
11764# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11765 end do
11766# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11767
11768# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11769 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
11770# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11771
11772# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11773 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
11774# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11775
11776# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11777 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
11778# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11779
11780# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11781 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
11782# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11783
11784# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11785 if (chemistry) then
11786# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11787 eps = 0.001_wp
11788# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11789 call get_species_enthalpies_rt(t_l, h_il)
11790# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11791 call get_species_enthalpies_rt(t_r, h_ir)
11792# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11793 h_il = h_il*gas_constant/molecular_weights*t_l
11794# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11795 h_ir = h_ir*gas_constant/molecular_weights*t_r
11796# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11797 call get_species_specific_heats_r(t_l, cp_il)
11798# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11799 call get_species_specific_heats_r(t_r, cp_ir)
11800# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11801
11802# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11803 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
11804# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11805 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
11806# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11807 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
11808# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11809 if (abs(t_l - t_r) < eps) then
11810# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11811 ! Case when T_L and T_R are very close
11812# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11813 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
11814# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11815 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
11816# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11817 & - gas_constant/molecular_weights(:)))
11818# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11819 else
11820# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11821 ! Normal calculation when T_L and T_R are sufficiently different
11822# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11823 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
11824# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11825 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
11826# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11827 end if
11828# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11829 gamma_avg = cp_avg/cv_avg
11830# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11831
11832# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11833 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
11834# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11835 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
11836# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11837 end if
11838# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11839 end if
11840# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11841
11842# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11843 if (avg_state == 2) then
11844# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11845 rho_avg = 5.e-1_wp*(rho_l + rho_r)
11846# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11847 vel_avg_rms = 0._wp
11848# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11849
11850# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11851#if defined(MFC_OpenACC)
11852# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11853!$acc loop seq
11854# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11855#elif defined(MFC_OpenMP)
11856# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11857
11858# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11859#endif
11860# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11861 do i = 1, num_vels
11862# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11863 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
11864# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11865 end do
11866# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11867
11868# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11869 h_avg = 5.e-1_wp*(h_l + h_r)
11870# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11871 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
11872# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11873 qv_avg = 5.e-1_wp*(qv_l + qv_r)
11874# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11875 end if
11876
11877 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
11878 & c_l, qv_l)
11879
11880 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
11881 & c_r, qv_r)
11882
11883 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
11884 ! variables are placeholders to call the subroutine.
11885 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
11886 & c_sum_yi_phi, c_avg, qv_avg)
11887
11888 if (viscous) then
11889 if (chemistry) then
11890 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
11891 end if
11892
11893# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11894#if defined(MFC_OpenACC)
11895# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11896!$acc loop seq
11897# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11898#elif defined(MFC_OpenMP)
11899# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11900
11901# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11902#endif
11903 do i = 1, 2
11904 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
11905 end do
11906 end if
11907
11908 ! Low Mach correction
11909 if (low_mach == 2) then
11910 if (riemann_solver == 1 .or. riemann_solver == 5) then
11911# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11912 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11913# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11914 pcorr = 0._wp
11915# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11916
11917# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11918 if (low_mach == 1) then
11919# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11920 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
11921# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11922 end if
11923# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11924 else if (riemann_solver == 2) then
11925# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11926 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11927# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11928 pcorr = 0._wp
11929# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11930
11931# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11932 if (low_mach == 1) then
11933# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11934 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))) &
11935# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11936 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
11937# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11938 else if (low_mach == 2) then
11939# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11940 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))))
11941# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11942 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))))
11943# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11944 vel_l(dir_idx(1)) = vel_l_tmp
11945# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11946 vel_r(dir_idx(1)) = vel_r_tmp
11947# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11948 end if
11949# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11950 end if
11951 end if
11952
11953 if (wave_speeds == 1) then
11954 if (elasticity) then
11955 ! Elastic wave speed, Rodriguez et al. JCP (2019)
11956 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) &
11957 & ))/rho_l), &
11958 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
11959 & + tau_e_r(dir_idx_tau(1)))/rho_r))
11960 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) &
11961 & ))/rho_r), &
11962 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
11963 & + tau_e_l(dir_idx_tau(1)))/rho_l))
11964 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
11965 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
11966 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
11967 & - vel_r(dir_idx(1))))
11968 else
11969 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
11970 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
11971 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
11972 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
11973 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
11974 end if
11975 else if (wave_speeds == 2) then
11976 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
11977
11978 pres_sr = pres_sl
11979
11980 ! Low Mach correction: Thornber et al. JCP (2008)
11981 ms_l = max(1._wp, &
11982 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
11983 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
11984 ms_r = max(1._wp, &
11985 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
11986 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
11987
11988 s_l = vel_l(dir_idx(1)) - c_l*ms_l
11989 s_r = vel_r(dir_idx(1)) + c_r*ms_r
11990
11991 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
11992 end if
11993
11994 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
11995 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
11996
11997 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
11998 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
11999 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
12000 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
12001 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
12002 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
12003
12004 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
12005 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
12006 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
12007
12008 ! Low Mach correction
12009 if (low_mach == 1) then
12010 if (riemann_solver == 1 .or. riemann_solver == 5) then
12011# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12012 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12013# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12014 pcorr = 0._wp
12015# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12016
12017# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12018 if (low_mach == 1) then
12019# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12020 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12021# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12022 end if
12023# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12024 else if (riemann_solver == 2) then
12025# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12026 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12027# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12028 pcorr = 0._wp
12029# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12030
12031# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12032 if (low_mach == 1) then
12033# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12034 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))) &
12035# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12036 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
12037# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12038 else if (low_mach == 2) then
12039# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12040 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))))
12041# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12042 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))))
12043# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12044 vel_l(dir_idx(1)) = vel_l_tmp
12045# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12046 vel_r(dir_idx(1)) = vel_r_tmp
12047# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12048 end if
12049# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12050 end if
12051 else
12052 pcorr = 0._wp
12053 end if
12054
12055 ! COMPUTING THE HLLC FLUXES MASS FLUX.
12056
12057# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12058#if defined(MFC_OpenACC)
12059# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12060!$acc loop seq
12061# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12062#elif defined(MFC_OpenMP)
12063# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12064
12065# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12066#endif
12067 do i = 1, eqn_idx%cont%end
12068 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
12069 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
12070 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
12071 end do
12072
12073 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
12074 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
12075
12076# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12077#if defined(MFC_OpenACC)
12078# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12079!$acc loop seq
12080# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12081#elif defined(MFC_OpenMP)
12082# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12083
12084# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12085#endif
12086 do i = 1, num_dims
12087 flux_rsx_vf(j, k, l, &
12088 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
12089 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
12090 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
12091 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
12092 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
12093 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
12094 end do
12095
12096 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
12097 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
12098 flux_rsx_vf(j, k, l, &
12099 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 + xi_l*(s_s &
12100 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
12101 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
12102 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
12103 & *(s_p/s_r)*pcorr*s_s
12104
12105 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
12106 if (elasticity) then
12107 flux_ene_e = 0._wp
12108
12109# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12110#if defined(MFC_OpenACC)
12111# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12112!$acc loop seq
12113# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12114#elif defined(MFC_OpenMP)
12115# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12116
12117# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12118#endif
12119 do i = 1, num_dims
12120 ! MOMENTUM ELASTIC FLUX.
12121 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
12122 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
12123 & - xi_p*tau_e_r(dir_idx_tau(i))
12124 ! ENERGY ELASTIC FLUX.
12125 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
12126 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
12127 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
12128 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
12129 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
12130 end do
12131 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
12132 end if
12133
12134 ! HYPOELASTIC STRESS EVOLUTION FLUX.
12135 if (hypoelasticity) then
12136
12137# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12138#if defined(MFC_OpenACC)
12139# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12140!$acc loop seq
12141# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12142#elif defined(MFC_OpenMP)
12143# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12144
12145# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12146#endif
12147 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
12148 flux_rsx_vf(j, k, l, &
12149 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
12150 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
12151 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
12152 end do
12153 end if
12154
12155 ! VOLUME FRACTION FLUX.
12156
12157# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12158#if defined(MFC_OpenACC)
12159# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12160!$acc loop seq
12161# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12162#elif defined(MFC_OpenMP)
12163# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12164
12165# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12166#endif
12167 do i = eqn_idx%adv%beg, eqn_idx%adv%end
12168 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
12169 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
12170 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
12171 end do
12172
12173 ! VOLUME FRACTION SOURCE FLUX.
12174
12175# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12176#if defined(MFC_OpenACC)
12177# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12178!$acc loop seq
12179# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12180#elif defined(MFC_OpenMP)
12181# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12182
12183# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12184#endif
12185 do i = 1, num_dims
12186 vel_src_rsx_vf(j, k, l, &
12187 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
12188 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
12189 end do
12190
12191 ! COLOR FUNCTION FLUX
12192 if (surface_tension) then
12193 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
12194 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
12195 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
12196 end if
12197
12198 ! Hyperelastic reference map flux for material deformation tracking
12199 if (hyperelasticity) then
12200
12201# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12202#if defined(MFC_OpenACC)
12203# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12204!$acc loop seq
12205# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12206#elif defined(MFC_OpenMP)
12207# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12208
12209# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12210#endif
12211 do i = 1, num_dims
12212 flux_rsx_vf(j, k, l, &
12213 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
12214 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
12215 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
12216 end do
12217 end if
12218
12219 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
12220
12221 if (chemistry) then
12222
12223# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12224#if defined(MFC_OpenACC)
12225# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12226!$acc loop seq
12227# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12228#elif defined(MFC_OpenMP)
12229# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12230
12231# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12232#endif
12233 do i = eqn_idx%species%beg, eqn_idx%species%end
12234 y_l = ql_prim_rsx_vf(j, k, l, i)
12235 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
12236
12237 flux_rsx_vf(j, k, l, &
12238 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
12239 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
12240 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
12241 end do
12242 end if
12243
12244 ! Geometrical source flux for cylindrical coordinates
12245# 3224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12246 if (cyl_coord) then
12247 ! Substituting the advective flux into the inviscid geometrical source flux
12248
12249# 3226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12250#if defined(MFC_OpenACC)
12251# 3226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12252!$acc loop seq
12253# 3226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12254#elif defined(MFC_OpenMP)
12255# 3226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12256
12257# 3226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12258#endif
12259 do i = 1, eqn_idx%E
12260 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
12261 end do
12262 ! Recalculating the radial momentum geometric source flux
12263 flux_gsrc_rsx_vf(j, k, l, &
12264 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
12265 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
12266 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
12267 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
12268 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
12269 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
12270 ! Geometrical source of the void fraction(s) is zero
12271
12272# 3239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12273#if defined(MFC_OpenACC)
12274# 3239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12275!$acc loop seq
12276# 3239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12277#elif defined(MFC_OpenMP)
12278# 3239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12279
12280# 3239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12281#endif
12282 do i = eqn_idx%adv%beg, eqn_idx%adv%end
12283 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
12284 end do
12285 end if
12286# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12287# 3262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12288 end do
12289 end do
12290 end do
12291
12292# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12293#if defined(MFC_OpenACC)
12294# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12295!$acc end parallel loop
12296# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12297#elif defined(MFC_OpenMP)
12298# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12299
12300# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12301!$omp end target teams loop
12302# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12303#endif
12304 end if
12305 end if
12306# 1776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12307# 1777 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12308# 1778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12309 if (norm_dir == 3) then
12310 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
12311 if (model_eqns == 3) then
12312 ! 6-equation model (model_eqns=3): separate phasic internal energies
12313
12314# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12315
12316# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12317#if defined(MFC_OpenACC)
12318# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12319!$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_L_m1, xi_R_m1, xi_MP, xi_PP)
12320# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12321#elif defined(MFC_OpenMP)
12322# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12323
12324# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12325
12326# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12327
12328# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12329!$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_L_m1, xi_R_m1, xi_MP, xi_PP)
12330# 1782 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12331#endif
12332# 1792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12333 do l = is1%beg, is1%end
12334 do k = is2%beg, is2%end
12335 do j = is3%beg, is3%end
12336 vel_l_rms = 0._wp; vel_r_rms = 0._wp
12337 rho_l = 0._wp; rho_r = 0._wp
12338 gamma_l = 0._wp; gamma_r = 0._wp
12339 pi_inf_l = 0._wp; pi_inf_r = 0._wp
12340 qv_l = 0._wp; qv_r = 0._wp
12341 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
12342
12343
12344# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12345#if defined(MFC_OpenACC)
12346# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12347!$acc loop seq
12348# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12349#elif defined(MFC_OpenMP)
12350# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12351
12352# 1802 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12353#endif
12354 do i = 1, num_dims
12355 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
12356 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
12357 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
12358 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
12359 end do
12360
12361 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
12362 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
12363
12364 rho_l = 0._wp
12365 gamma_l = 0._wp
12366 pi_inf_l = 0._wp
12367 qv_l = 0._wp
12368
12369 rho_r = 0._wp
12370 gamma_r = 0._wp
12371 pi_inf_r = 0._wp
12372 qv_r = 0._wp
12373
12374 alpha_l_sum = 0._wp
12375 alpha_r_sum = 0._wp
12376
12377 if (mpp_lim) then
12378
12379# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12380#if defined(MFC_OpenACC)
12381# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12382!$acc loop seq
12383# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12384#elif defined(MFC_OpenMP)
12385# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12386
12387# 1827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12388#endif
12389 do i = 1, num_fluids
12390 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
12391 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
12392 & eqn_idx%E + i)), 1._wp)
12393 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
12394 end do
12395
12396
12397# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12398#if defined(MFC_OpenACC)
12399# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12400!$acc loop seq
12401# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12402#elif defined(MFC_OpenMP)
12403# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12404
12405# 1835 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12406#endif
12407 do i = 1, num_fluids
12408 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
12409 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
12410 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
12411 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
12412 end do
12413
12414
12415# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12416#if defined(MFC_OpenACC)
12417# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12418!$acc loop seq
12419# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12420#elif defined(MFC_OpenMP)
12421# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12422
12423# 1843 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12424#endif
12425 do i = 1, num_fluids
12426 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
12427 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
12428 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
12429 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
12430 end do
12431 end if
12432
12433
12434# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12435#if defined(MFC_OpenACC)
12436# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12437!$acc loop seq
12438# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12439#elif defined(MFC_OpenMP)
12440# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12441
12442# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12443#endif
12444 do i = 1, num_fluids
12445 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
12446 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
12447 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
12448 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
12449
12450 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
12451 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
12452 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
12453 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
12454
12455 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
12456 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%adv%beg + i - 1)
12457 end do
12458
12459 if (viscous) then
12460
12461# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12462#if defined(MFC_OpenACC)
12463# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12464!$acc loop seq
12465# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12466#elif defined(MFC_OpenMP)
12467# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12468
12469# 1869 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12470#endif
12471 do i = 1, 2
12472 re_l(i) = dflt_real
12473 re_r(i) = dflt_real
12474 if (re_size(i) > 0) re_l(i) = 0._wp
12475 if (re_size(i) > 0) re_r(i) = 0._wp
12476
12477# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12478#if defined(MFC_OpenACC)
12479# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12480!$acc loop seq
12481# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12482#elif defined(MFC_OpenMP)
12483# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12484
12485# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12486#endif
12487 do q = 1, re_size(i)
12488 re_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
12489 re_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + re_idx(i, q))/res_gs(i, &
12490 & q) + re_r(i)
12491 end do
12492 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
12493 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
12494 end do
12495 end if
12496
12497 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
12498 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
12499
12500 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
12501 if (hypoelasticity) then
12502
12503# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12504#if defined(MFC_OpenACC)
12505# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12506!$acc loop seq
12507# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12508#elif defined(MFC_OpenMP)
12509# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12510
12511# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12512#endif
12513 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
12514 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
12515 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
12516 end do
12517 g_l = 0._wp; g_r = 0._wp
12518
12519# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12520#if defined(MFC_OpenACC)
12521# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12522!$acc loop seq
12523# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12524#elif defined(MFC_OpenMP)
12525# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12526
12527# 1897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12528#endif
12529 do i = 1, num_fluids
12530 g_l = g_l + alpha_l(i)*gs_rs(i)
12531 g_r = g_r + alpha_r(i)*gs_rs(i)
12532 end do
12533
12534# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12535#if defined(MFC_OpenACC)
12536# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12537!$acc loop seq
12538# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12539#elif defined(MFC_OpenMP)
12540# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12541
12542# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12543#endif
12544 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
12545 ! Elastic contribution to energy if G large enough
12546 if ((g_l > verysmall) .and. (g_r > verysmall)) then
12547 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
12548 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
12549 ! Additional terms in 2D and 3D
12550 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
12551 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
12552 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
12553 end if
12554 end if
12555 end do
12556 end if
12557
12558 ! Hyperelastic stress contribution: strain energy added to total energy
12559 if (hyperelasticity) then
12560
12561# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12562#if defined(MFC_OpenACC)
12563# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12564!$acc loop seq
12565# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12566#elif defined(MFC_OpenMP)
12567# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12568
12569# 1919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12570#endif
12571 do i = 1, num_dims
12572 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
12573 xi_field_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%beg - 1 + i)
12574 end do
12575 g_l = 0._wp; g_r = 0._wp
12576
12577# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12578#if defined(MFC_OpenACC)
12579# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12580!$acc loop seq
12581# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12582#elif defined(MFC_OpenMP)
12583# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12584
12585# 1925 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12586#endif
12587 do i = 1, num_fluids
12588 ! Mixture left and right shear modulus
12589 g_l = g_l + alpha_l(i)*gs_rs(i)
12590 g_r = g_r + alpha_r(i)*gs_rs(i)
12591 end do
12592 ! Elastic contribution to energy if G large enough
12593 if (g_l > verysmall .and. g_r > verysmall) then
12594 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
12595 e_r = e_r + g_r*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%end + 1)
12596 end if
12597
12598# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12599#if defined(MFC_OpenACC)
12600# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12601!$acc loop seq
12602# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12603#elif defined(MFC_OpenMP)
12604# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12605
12606# 1936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12607#endif
12608 do i = 1, b_size - 1
12609 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
12610 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
12611 end do
12612 end if
12613
12614 h_l = (e_l + pres_l)/rho_l
12615 h_r = (e_r + pres_r)/rho_r
12616
12617 if (avg_state == 1) then
12618# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12619 rho_avg = sqrt(rho_l*rho_r)
12620# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12621
12622# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12623 vel_avg_rms = 0._wp
12624# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12625
12626# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12627
12628# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12629#if defined(MFC_OpenACC)
12630# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12631!$acc loop seq
12632# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12633#elif defined(MFC_OpenMP)
12634# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12635
12636# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12637#endif
12638# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12639 do i = 1, num_vels
12640# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12641 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
12642# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12643 end do
12644# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12645
12646# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12647 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
12648# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12649
12650# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12651 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
12652# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12653
12654# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12655 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
12656# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12657
12658# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12659 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
12660# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12661
12662# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12663 if (chemistry) then
12664# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12665 eps = 0.001_wp
12666# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12667 call get_species_enthalpies_rt(t_l, h_il)
12668# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12669 call get_species_enthalpies_rt(t_r, h_ir)
12670# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12671 h_il = h_il*gas_constant/molecular_weights*t_l
12672# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12673 h_ir = h_ir*gas_constant/molecular_weights*t_r
12674# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12675 call get_species_specific_heats_r(t_l, cp_il)
12676# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12677 call get_species_specific_heats_r(t_r, cp_ir)
12678# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12679
12680# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12681 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
12682# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12683 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
12684# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12685 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
12686# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12687 if (abs(t_l - t_r) < eps) then
12688# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12689 ! Case when T_L and T_R are very close
12690# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12691 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
12692# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12693 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
12694# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12695 & - gas_constant/molecular_weights(:)))
12696# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12697 else
12698# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12699 ! Normal calculation when T_L and T_R are sufficiently different
12700# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12701 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
12702# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12703 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
12704# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12705 end if
12706# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12707 gamma_avg = cp_avg/cv_avg
12708# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12709
12710# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12711 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
12712# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12713 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
12714# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12715 end if
12716# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12717 end if
12718# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12719
12720# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12721 if (avg_state == 2) then
12722# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12723 rho_avg = 5.e-1_wp*(rho_l + rho_r)
12724# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12725 vel_avg_rms = 0._wp
12726# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12727
12728# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12729#if defined(MFC_OpenACC)
12730# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12731!$acc loop seq
12732# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12733#elif defined(MFC_OpenMP)
12734# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12735
12736# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12737#endif
12738# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12739 do i = 1, num_vels
12740# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12741 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
12742# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12743 end do
12744# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12745
12746# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12747 h_avg = 5.e-1_wp*(h_l + h_r)
12748# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12749 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
12750# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12751 qv_avg = 5.e-1_wp*(qv_l + qv_r)
12752# 1946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12753 end if
12754
12755 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
12756 & c_l, qv_l)
12757
12758 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
12759 & c_r, qv_r)
12760
12761 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
12762 ! variables are placeholders to call the subroutine.
12763 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
12764 & 0._wp, c_avg, qv_avg)
12765
12766 if (viscous) then
12767
12768# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12769#if defined(MFC_OpenACC)
12770# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12771!$acc loop seq
12772# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12773#elif defined(MFC_OpenMP)
12774# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12775
12776# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12777#endif
12778 do i = 1, 2
12779 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
12780 end do
12781 end if
12782
12783 ! Low Mach correction
12784 if (low_mach == 2) then
12785 if (riemann_solver == 1 .or. riemann_solver == 5) then
12786# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12787 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12788# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12789 pcorr = 0._wp
12790# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12791
12792# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12793 if (low_mach == 1) then
12794# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12795 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12796# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12797 end if
12798# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12799 else if (riemann_solver == 2) then
12800# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12801 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12802# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12803 pcorr = 0._wp
12804# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12805
12806# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12807 if (low_mach == 1) then
12808# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12809 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))) &
12810# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12811 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
12812# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12813 else if (low_mach == 2) then
12814# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12815 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))))
12816# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12817 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))))
12818# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12819 vel_l(dir_idx(1)) = vel_l_tmp
12820# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12821 vel_r(dir_idx(1)) = vel_r_tmp
12822# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12823 end if
12824# 1968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12825 end if
12826 end if
12827
12828 ! COMPUTING THE DIRECT WAVE SPEEDS
12829 if (wave_speeds == 1) then
12830 if (elasticity) then
12831 ! Elastic wave speed, Rodriguez et al. JCP (2019)
12832 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) &
12833 & ))/rho_l), &
12834 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
12835 & + tau_e_r(dir_idx_tau(1)))/rho_r))
12836 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) &
12837 & ))/rho_r), &
12838 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
12839 & + tau_e_l(dir_idx_tau(1)))/rho_l))
12840 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
12841 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
12842 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
12843 & - vel_r(dir_idx(1))))
12844 else
12845 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
12846 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
12847 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
12848 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
12849 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
12850 end if
12851 else if (wave_speeds == 2) then
12852 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
12853
12854 pres_sr = pres_sl
12855
12856 ! Low Mach correction: Thornber et al. JCP (2008)
12857 ms_l = max(1._wp, &
12858 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
12859 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
12860 ms_r = max(1._wp, &
12861 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
12862 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
12863
12864 s_l = vel_l(dir_idx(1)) - c_l*ms_l
12865 s_r = vel_r(dir_idx(1)) + c_r*ms_r
12866
12867 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
12868 end if
12869
12870 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
12871 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
12872
12873 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
12874 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
12875 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
12876 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
12877 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
12878
12879 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
12880 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
12881 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
12882
12883 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
12884 xi_mp = -min(0._wp, sign(1._wp, s_l))
12885 xi_pp = max(0._wp, sign(1._wp, s_r))
12886
12887 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 &
12888 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
12889 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
12890 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
12891 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
12892
12893 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))
12894
12895 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 &
12896 & - vel_r(dir_idx(1)))
12897
12898 ! Low Mach correction
12899 if (low_mach == 1) then
12900 if (riemann_solver == 1 .or. riemann_solver == 5) then
12901# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12902 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12903# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12904 pcorr = 0._wp
12905# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12906
12907# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12908 if (low_mach == 1) then
12909# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12910 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12911# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12912 end if
12913# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12914 else if (riemann_solver == 2) then
12915# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12916 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12917# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12918 pcorr = 0._wp
12919# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12920
12921# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12922 if (low_mach == 1) then
12923# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12924 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))) &
12925# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12926 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
12927# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12928 else if (low_mach == 2) then
12929# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12930 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))))
12931# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12932 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))))
12933# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12934 vel_l(dir_idx(1)) = vel_l_tmp
12935# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12936 vel_r(dir_idx(1)) = vel_r_tmp
12937# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12938 end if
12939# 2043 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12940 end if
12941 else
12942 pcorr = 0._wp
12943 end if
12944
12945 ! COMPUTING FLUXES MASS FLUX.
12946
12947# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12948#if defined(MFC_OpenACC)
12949# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12950!$acc loop seq
12951# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12952#elif defined(MFC_OpenMP)
12953# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12954
12955# 2049 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12956#endif
12957 do i = 1, eqn_idx%cont%end
12958 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
12959 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
12960 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
12961 end do
12962
12963 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
12964
12965# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12966#if defined(MFC_OpenACC)
12967# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12968!$acc loop seq
12969# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12970#elif defined(MFC_OpenMP)
12971# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12972
12973# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12974#endif
12975 do i = 1, num_dims
12976 flux_rsx_vf(j, k, l, &
12977 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
12978 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
12979 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
12980 & *dir_flg(dir_idx(i))*pcorr
12981 end do
12982
12983 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
12984 flux_rsx_vf(j, k, l, eqn_idx%E) = (e_star + p_star)*vel_k_star + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
12985
12986 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
12987 if (elasticity) then
12988 flux_ene_e = 0._wp
12989
12990# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12991#if defined(MFC_OpenACC)
12992# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12993!$acc loop seq
12994# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12995#elif defined(MFC_OpenMP)
12996# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12997
12998# 2072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12999#endif
13000 do i = 1, num_dims
13001 ! MOMENTUM ELASTIC FLUX.
13002 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
13003 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
13004 & - xi_p*tau_e_r(dir_idx_tau(i))
13005 ! ENERGY ELASTIC FLUX.
13006 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
13007 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
13008 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
13009 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
13010 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
13011 end do
13012 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
13013 end if
13014
13015 ! VOLUME FRACTION FLUX.
13016
13017# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13018#if defined(MFC_OpenACC)
13019# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13020!$acc loop seq
13021# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13022#elif defined(MFC_OpenMP)
13023# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13024
13025# 2089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13026#endif
13027 do i = eqn_idx%adv%beg, eqn_idx%adv%end
13028 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
13029 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k, l + 1, i)*s_s
13030 end do
13031
13032 ! Advection velocity source: interface velocity for volume fraction transport
13033
13034# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13035#if defined(MFC_OpenACC)
13036# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13037!$acc loop seq
13038# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13039#elif defined(MFC_OpenMP)
13040# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13041
13042# 2096 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13043#endif
13044 do i = 1, num_dims
13045 vel_src_rsx_vf(j, k, l, &
13046 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
13047 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
13048 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
13049 end do
13050
13051 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
13052 ! energy flux
13053
13054# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13055#if defined(MFC_OpenACC)
13056# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13057!$acc loop seq
13058# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13059#elif defined(MFC_OpenMP)
13060# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13061
13062# 2106 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13063#endif
13064 do i = 1, num_fluids
13065 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
13066 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
13067 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
13068 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
13069 & + pres_r)
13070
13071 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
13072 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
13073 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
13074 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
13075 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
13076 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
13077 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
13078 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
13079 & i + eqn_idx%adv%beg - 1))
13080 end do
13081
13082 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
13083
13084 ! HYPOELASTIC STRESS EVOLUTION FLUX.
13085 if (hypoelasticity) then
13086
13087# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13088#if defined(MFC_OpenACC)
13089# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13090!$acc loop seq
13091# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13092#elif defined(MFC_OpenMP)
13093# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13094
13095# 2129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13096#endif
13097 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
13098 flux_rsx_vf(j, k, l, &
13099 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
13100 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
13101 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
13102 end do
13103 end if
13104
13105 ! Hyperelastic reference map flux for material deformation tracking
13106 if (hyperelasticity) then
13107
13108# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13109#if defined(MFC_OpenACC)
13110# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13111!$acc loop seq
13112# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13113#elif defined(MFC_OpenMP)
13114# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13115
13116# 2140 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13117#endif
13118 do i = 1, num_dims
13119 flux_rsx_vf(j, k, l, &
13120 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
13121 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
13122 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
13123 end do
13124 end if
13125
13126 ! COLOR FUNCTION FLUX
13127 if (surface_tension) then
13128 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
13129 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%c))*s_s
13130 end if
13131
13132 ! Geometrical source flux for cylindrical coordinates
13133# 2178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13134# 2179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13135 if (grid_geometry == 3) then
13136
13137# 2180 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13138#if defined(MFC_OpenACC)
13139# 2180 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13140!$acc loop seq
13141# 2180 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13142#elif defined(MFC_OpenMP)
13143# 2180 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13144
13145# 2180 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13146#endif
13147 do i = 1, sys_size
13148 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
13149 end do
13150 flux_gsrc_rsx_vf(j, k, l, &
13151 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
13152 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
13153
13154 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
13155 end if
13156# 2191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13157 end do
13158 end do
13159 end do
13160
13161# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13162#if defined(MFC_OpenACC)
13163# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13164!$acc end parallel loop
13165# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13166#elif defined(MFC_OpenMP)
13167# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13168
13169# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13170!$omp end target teams loop
13171# 2194 "/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# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13177
13178# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13179#if defined(MFC_OpenACC)
13180# 2197 "/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_L_m1, xi_R_m1, 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# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13183#elif defined(MFC_OpenMP)
13184# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13185
13186# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13187
13188# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13189
13190# 2197 "/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_L_m1, xi_R_m1, 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# 2197 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13193#endif
13194# 2206 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13195 do l = is1%beg, is1%end
13196 do k = is2%beg, is2%end
13197 do j = is3%beg, is3%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# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13206#if defined(MFC_OpenACC)
13207# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13208!$acc loop seq
13209# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13210#elif defined(MFC_OpenMP)
13211# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13212
13213# 2215 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13214#endif
13215 do i = 1, eqn_idx%cont%end
13216 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
13217 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
13218 end do
13219
13220
13221# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13222#if defined(MFC_OpenACC)
13223# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13224!$acc loop seq
13225# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13226#elif defined(MFC_OpenMP)
13227# 2221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13228
13229# 2221 "/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_rsx_vf(j, k, l, eqn_idx%cont%end + i)
13233 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + 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# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13240#if defined(MFC_OpenACC)
13241# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13242!$acc loop seq
13243# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13244#elif defined(MFC_OpenMP)
13245# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13246
13247# 2229 "/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_rsx_vf(j, k, l, eqn_idx%E + i)
13251 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
13252 end do
13253
13254# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13255#if defined(MFC_OpenACC)
13256# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13257!$acc loop seq
13258# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13259#elif defined(MFC_OpenMP)
13260# 2234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13261
13262# 2234 "/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_rsx_vf(j, k, l, eqn_idx%E + i)
13266 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
13267 end do
13268
13269
13270# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13271#if defined(MFC_OpenACC)
13272# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13273!$acc loop seq
13274# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13275#elif defined(MFC_OpenMP)
13276# 2240 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13277
13278# 2240 "/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_rsx_vf(j, k, l, eqn_idx%E)
13293 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
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# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13303 rho_avg = sqrt(rho_l*rho_r)
13304# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13305
13306# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13307 vel_avg_rms = 0._wp
13308# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13309
13310# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13311
13312# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13313#if defined(MFC_OpenACC)
13314# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13315!$acc loop seq
13316# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13317#elif defined(MFC_OpenMP)
13318# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13319
13320# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13321#endif
13322# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13323 do i = 1, num_vels
13324# 2262 "/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# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13327 end do
13328# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13329
13330# 2262 "/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# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13333
13334# 2262 "/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# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13337
13338# 2262 "/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# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13341
13342# 2262 "/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# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13345
13346# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13347 if (chemistry) then
13348# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13349 eps = 0.001_wp
13350# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13351 call get_species_enthalpies_rt(t_l, h_il)
13352# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13353 call get_species_enthalpies_rt(t_r, h_ir)
13354# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13355 h_il = h_il*gas_constant/molecular_weights*t_l
13356# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13357 h_ir = h_ir*gas_constant/molecular_weights*t_r
13358# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13359 call get_species_specific_heats_r(t_l, cp_il)
13360# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13361 call get_species_specific_heats_r(t_r, cp_ir)
13362# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13363
13364# 2262 "/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# 2262 "/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# 2262 "/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# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13371 if (abs(t_l - t_r) < eps) then
13372# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13373 ! Case when T_L and T_R are very close
13374# 2262 "/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# 2262 "/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# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13379 & - gas_constant/molecular_weights(:)))
13380# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13381 else
13382# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13383 ! Normal calculation when T_L and T_R are sufficiently different
13384# 2262 "/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# 2262 "/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# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13389 end if
13390# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13391 gamma_avg = cp_avg/cv_avg
13392# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13393
13394# 2262 "/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# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13397 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
13398# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13399 end if
13400# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13401 end if
13402# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13403
13404# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13405 if (avg_state == 2) then
13406# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13407 rho_avg = 5.e-1_wp*(rho_l + rho_r)
13408# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13409 vel_avg_rms = 0._wp
13410# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13411
13412# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13413#if defined(MFC_OpenACC)
13414# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13415!$acc loop seq
13416# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13417#elif defined(MFC_OpenMP)
13418# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13419
13420# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13421#endif
13422# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13423 do i = 1, num_vels
13424# 2262 "/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# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13427 end do
13428# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13429
13430# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13431 h_avg = 5.e-1_wp*(h_l + h_r)
13432# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13433 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
13434# 2262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13435 qv_avg = 5.e-1_wp*(qv_l + qv_r)
13436# 2262 "/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)))/min(s_l - s_s, -sgm_eps)
13482 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
13483 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
13484 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
13485
13486 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
13487 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
13488 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
13489
13490
13491# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13492#if defined(MFC_OpenACC)
13493# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13494!$acc loop seq
13495# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13496#elif defined(MFC_OpenMP)
13497# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13498
13499# 2315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13500#endif
13501 do i = 1, eqn_idx%cont%end
13502 flux_rsx_vf(j, k, l, &
13503 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
13504 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
13505 end do
13506
13507 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
13508
13509# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13510#if defined(MFC_OpenACC)
13511# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13512!$acc loop seq
13513# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13514#elif defined(MFC_OpenMP)
13515# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13516
13517# 2323 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13518#endif
13519 do i = 1, num_dims
13520 flux_rsx_vf(j, k, l, &
13521 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
13522 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
13523 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
13524 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
13525 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
13526 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
13527 end do
13528
13529 if (bubbles_euler) then
13530 ! Put p_tilde in
13531
13532# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13533#if defined(MFC_OpenACC)
13534# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13535!$acc loop seq
13536# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13537#elif defined(MFC_OpenMP)
13538# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13539
13540# 2336 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13541#endif
13542 do i = 1, num_dims
13543 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
13544 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
13545 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
13546 end do
13547 end if
13548
13549 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
13550
13551
13552# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13553#if defined(MFC_OpenACC)
13554# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13555!$acc loop seq
13556# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13557#elif defined(MFC_OpenMP)
13558# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13559
13560# 2346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13561#endif
13562 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
13563 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
13564 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
13565 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
13566 end do
13567
13568 ! Advection velocity source: interface velocity for volume fraction transport
13569
13570# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13571#if defined(MFC_OpenACC)
13572# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13573!$acc loop seq
13574# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13575#elif defined(MFC_OpenMP)
13576# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13577
13578# 2354 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13579#endif
13580 do i = 1, num_dims
13581 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
13582 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
13583 end do
13584
13585 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
13586
13587 ! Add advection flux for bubble variables
13588 if (bubbles_euler) then
13589
13590# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13591#if defined(MFC_OpenACC)
13592# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13593!$acc loop seq
13594# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13595#elif defined(MFC_OpenMP)
13596# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13597
13598# 2364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13599#endif
13600 do i = eqn_idx%bub%beg, eqn_idx%bub%end
13601 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
13602 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
13603 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k, l + 1, &
13604 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
13605 end do
13606 end if
13607
13608 ! Geometrical source flux for cylindrical coordinates
13609
13610# 2397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13611# 2398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13612 if (grid_geometry == 3) then
13613
13614# 2399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13615#if defined(MFC_OpenACC)
13616# 2399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13617!$acc loop seq
13618# 2399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13619#elif defined(MFC_OpenMP)
13620# 2399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13621
13622# 2399 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13623#endif
13624 do i = 1, sys_size
13625 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
13626 end do
13627 flux_gsrc_rsx_vf(j, k, l, &
13628 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1) &
13629 & ) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
13630 & *vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
13631 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
13632 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
13633 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
13634 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
13635 end if
13636# 2413 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13637 end do
13638 end do
13639 end do
13640
13641# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13642#if defined(MFC_OpenACC)
13643# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13644!$acc end parallel loop
13645# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13646#elif defined(MFC_OpenMP)
13647# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13648
13649# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13650!$omp end target teams loop
13651# 2416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13652#endif
13653 else if (model_eqns == 2 .and. bubbles_euler) then
13654 ! 5-equation model with Euler-Euler bubble dynamics
13655
13656# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13657
13658# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13659#if defined(MFC_OpenACC)
13660# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13661!$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_L_m1, xi_R_m1, 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)
13662# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13663#elif defined(MFC_OpenMP)
13664# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13665
13666# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13667
13668# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13669
13670# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13671!$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_L_m1, xi_R_m1, 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)
13672# 2419 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13673#endif
13674# 2427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13675 do l = is1%beg, is1%end
13676 do k = is2%beg, is2%end
13677 do j = is3%beg, is3%end
13678 vel_l_rms = 0._wp; vel_r_rms = 0._wp
13679 rho_l = 0._wp; rho_r = 0._wp
13680 gamma_l = 0._wp; gamma_r = 0._wp
13681 pi_inf_l = 0._wp; pi_inf_r = 0._wp
13682 qv_l = 0._wp; qv_r = 0._wp
13683
13684
13685# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13686#if defined(MFC_OpenACC)
13687# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13688!$acc loop seq
13689# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13690#elif defined(MFC_OpenMP)
13691# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13692
13693# 2436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13694#endif
13695 do i = 1, num_fluids
13696 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
13697 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
13698 end do
13699
13700 vel_l_rms = 0._wp; vel_r_rms = 0._wp
13701
13702
13703# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13704#if defined(MFC_OpenACC)
13705# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13706!$acc loop seq
13707# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13708#elif defined(MFC_OpenMP)
13709# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13710
13711# 2444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13712#endif
13713 do i = 1, num_dims
13714 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
13715 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
13716 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
13717 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
13718 end do
13719
13720 ! Retain this in the refactor
13721 if (mpp_lim .and. (num_fluids > 2)) then
13722
13723# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13724#if defined(MFC_OpenACC)
13725# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13726!$acc loop seq
13727# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13728#elif defined(MFC_OpenMP)
13729# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13730
13731# 2454 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13732#endif
13733 do i = 1, num_fluids
13734 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
13735 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
13736 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
13737 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
13738 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
13739 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
13740 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
13741 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
13742 end do
13743 else if (num_fluids > 2) then
13744
13745# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13746#if defined(MFC_OpenACC)
13747# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13748!$acc loop seq
13749# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13750#elif defined(MFC_OpenMP)
13751# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13752
13753# 2466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13754#endif
13755 do i = 1, num_fluids - 1
13756 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
13757 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
13758 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
13759 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
13760 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
13761 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
13762 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
13763 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
13764 end do
13765 else
13766 rho_l = ql_prim_rsx_vf(j, k, l, 1)
13767 gamma_l = gammas(1)
13768 pi_inf_l = pi_infs(1)
13769 qv_l = qvs(1)
13770 rho_r = qr_prim_rsx_vf(j, k, l + 1, 1)
13771 gamma_r = gammas(1)
13772 pi_inf_r = pi_infs(1)
13773 qv_r = qvs(1)
13774 end if
13775
13776 if (viscous) then
13777 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
13778
13779# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13780#if defined(MFC_OpenACC)
13781# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13782!$acc loop seq
13783# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13784#elif defined(MFC_OpenMP)
13785# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13786
13787# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13788#endif
13789 do i = 1, 2
13790 re_l(i) = dflt_real
13791 re_r(i) = dflt_real
13792
13793 if (re_size(i) > 0) re_l(i) = 0._wp
13794 if (re_size(i) > 0) re_r(i) = 0._wp
13795
13796
13797# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13798#if defined(MFC_OpenACC)
13799# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13800!$acc loop seq
13801# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13802#elif defined(MFC_OpenMP)
13803# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13804
13805# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13806#endif
13807 do q = 1, re_size(i)
13808 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
13809 & q)))/res_gs(i, q) + re_l(i)
13810 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + re_idx(i, &
13811 & q)))/res_gs(i, q) + re_r(i)
13812 end do
13813
13814 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
13815 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
13816 end do
13817 end if
13818 end if
13819
13820 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
13821 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
13822
13823 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
13824 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
13825
13826 h_l = (e_l + pres_l)/rho_l
13827 h_r = (e_r + pres_r)/rho_r
13828
13829 if (avg_state == 2) then
13830
13831# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13832#if defined(MFC_OpenACC)
13833# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13834!$acc loop seq
13835# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13836#elif defined(MFC_OpenMP)
13837# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13838
13839# 2522 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13840#endif
13841 do i = 1, nb
13842 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
13843 r0_r(i) = qr_prim_rsx_vf(j, k, l + 1, rs(i))
13844
13845 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
13846 v0_r(i) = qr_prim_rsx_vf(j, k, l + 1, vs(i))
13847 if (.not. polytropic .and. .not. qbmm) then
13848 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
13849 p0_r(i) = qr_prim_rsx_vf(j, k, l + 1, ps(i))
13850 end if
13851 end do
13852
13853 if (.not. qbmm) then
13854 if (adv_n) then
13855 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
13856 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%n)
13857 else
13858 nbub_l = 0._wp
13859 nbub_r = 0._wp
13860
13861# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13862#if defined(MFC_OpenACC)
13863# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13864!$acc loop seq
13865# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13866#elif defined(MFC_OpenMP)
13867# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13868
13869# 2542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13870#endif
13871 do i = 1, nb
13872 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
13873 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
13874 end do
13875
13876 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
13877 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k, l + 1, &
13878 & eqn_idx%E + num_fluids)/nbub_r
13879 end if
13880 else
13881 ! nb stored in 0th moment of first R0 bin in variable conversion module
13882 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
13883 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%bub%beg)
13884 end if
13885
13886
13887# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13888#if defined(MFC_OpenACC)
13889# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13890!$acc loop seq
13891# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13892#elif defined(MFC_OpenMP)
13893# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13894
13895# 2558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13896#endif
13897 do i = 1, nb
13898 if (.not. qbmm) then
13899 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
13900 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
13901 end if
13902 end do
13903
13904 if (qbmm) then
13905 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
13906 pbwr3rbar = mom_sp_rsx_vf(j, k, l + 1, 4)
13907
13908 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
13909 r3rbar = mom_sp_rsx_vf(j, k, l + 1, 1)
13910
13911 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
13912 r3v2rbar = mom_sp_rsx_vf(j, k, l + 1, 3)
13913 else
13914 pbwr3lbar = 0._wp
13915 pbwr3rbar = 0._wp
13916
13917 r3lbar = 0._wp
13918 r3rbar = 0._wp
13919
13920 r3v2lbar = 0._wp
13921 r3v2rbar = 0._wp
13922
13923
13924# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13925#if defined(MFC_OpenACC)
13926# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13927!$acc loop seq
13928# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13929#elif defined(MFC_OpenMP)
13930# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13931
13932# 2585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13933#endif
13934 do i = 1, nb
13935 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
13936 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
13937
13938 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
13939 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
13940
13941 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
13942 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
13943 end do
13944 end if
13945
13946 rho_avg = 5.e-1_wp*(rho_l + rho_r)
13947 h_avg = 5.e-1_wp*(h_l + h_r)
13948 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
13949 qv_avg = 5.e-1_wp*(qv_l + qv_r)
13950 vel_avg_rms = 0._wp
13951
13952
13953# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13954#if defined(MFC_OpenACC)
13955# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13956!$acc loop seq
13957# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13958#elif defined(MFC_OpenMP)
13959# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13960
13961# 2604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13962#endif
13963 do i = 1, num_dims
13964 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
13965 end do
13966 end if
13967
13968 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
13969 & c_l, qv_l)
13970
13971 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
13972 & c_r, qv_r)
13973
13974 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
13975 ! variables are placeholders to call the subroutine.
13976 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
13977 & 0._wp, c_avg, qv_avg)
13978
13979 if (viscous) then
13980
13981# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13982#if defined(MFC_OpenACC)
13983# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13984!$acc loop seq
13985# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13986#elif defined(MFC_OpenMP)
13987# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13988
13989# 2622 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13990#endif
13991 do i = 1, 2
13992 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
13993 end do
13994 end if
13995
13996 ! Low Mach correction
13997 if (low_mach == 2) then
13998 if (riemann_solver == 1 .or. riemann_solver == 5) then
13999# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14000 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14001# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14002 pcorr = 0._wp
14003# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14004
14005# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14006 if (low_mach == 1) then
14007# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14008 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14009# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14010 end if
14011# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14012 else if (riemann_solver == 2) then
14013# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14014 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14015# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14016 pcorr = 0._wp
14017# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14018
14019# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14020 if (low_mach == 1) then
14021# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14022 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))) &
14023# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14024 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14025# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14026 else if (low_mach == 2) then
14027# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14028 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))))
14029# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14030 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))))
14031# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14032 vel_l(dir_idx(1)) = vel_l_tmp
14033# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14034 vel_r(dir_idx(1)) = vel_r_tmp
14035# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14036 end if
14037# 2630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14038 end if
14039 end if
14040
14041 if (wave_speeds == 1) then
14042 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
14043 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
14044
14045 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
14046 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
14047 & - rho_r*(s_r - vel_r(dir_idx(1))))
14048 else if (wave_speeds == 2) then
14049 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
14050
14051 pres_sr = pres_sl
14052
14053 ! Low Mach correction: Thornber et al. JCP (2008)
14054 ms_l = max(1._wp, &
14055 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
14056 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
14057 ms_r = max(1._wp, &
14058 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
14059 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
14060
14061 s_l = vel_l(dir_idx(1)) - c_l*ms_l
14062 s_r = vel_r(dir_idx(1)) + c_r*ms_r
14063
14064 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
14065 end if
14066
14067 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
14068 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
14069
14070 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
14071 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
14072 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
14073 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
14074 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
14075
14076 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
14077 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
14078 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
14079
14080 ! Low Mach correction
14081 if (low_mach == 1) then
14082 if (riemann_solver == 1 .or. riemann_solver == 5) then
14083# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14084 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14085# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14086 pcorr = 0._wp
14087# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14088
14089# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14090 if (low_mach == 1) then
14091# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14092 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14093# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14094 end if
14095# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14096 else if (riemann_solver == 2) then
14097# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14098 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14099# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14100 pcorr = 0._wp
14101# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14102
14103# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14104 if (low_mach == 1) then
14105# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14106 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))) &
14107# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14108 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14109# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14110 else if (low_mach == 2) then
14111# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14112 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))))
14113# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14114 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))))
14115# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14116 vel_l(dir_idx(1)) = vel_l_tmp
14117# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14118 vel_r(dir_idx(1)) = vel_r_tmp
14119# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14120 end if
14121# 2674 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14122 end if
14123 else
14124 pcorr = 0._wp
14125 end if
14126
14127
14128# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14129#if defined(MFC_OpenACC)
14130# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14131!$acc loop seq
14132# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14133#elif defined(MFC_OpenMP)
14134# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14135
14136# 2679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14137#endif
14138 do i = 1, eqn_idx%cont%end
14139 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
14140 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
14141 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
14142 end do
14143
14144 if (bubbles_euler .and. (num_fluids > 1)) then
14145 ! Kill mass transport @ gas density
14146 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
14147 end if
14148
14149 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
14150
14151 ! Include p_tilde
14152
14153 if (avg_state == 2) then
14154 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
14155 pres_l = pres_l - alpha_l(num_fluids)*pres_l
14156 else
14157 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
14158 end if
14159
14160 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
14161 pres_r = pres_r - alpha_r(num_fluids)*pres_r
14162 else
14163 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
14164 end if
14165 end if
14166
14167
14168# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14169#if defined(MFC_OpenACC)
14170# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14171!$acc loop seq
14172# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14173#elif defined(MFC_OpenMP)
14174# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14175
14176# 2709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14177#endif
14178 do i = 1, num_dims
14179 flux_rsx_vf(j, k, l, &
14180 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
14181 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
14182 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
14183 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
14184 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
14185 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
14186 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
14187 end do
14188
14189 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
14190 flux_rsx_vf(j, k, l, &
14191 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
14192 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
14193 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
14194 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
14195 & *pcorr*s_s
14196
14197 ! Volume fraction flux
14198
14199# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14200#if defined(MFC_OpenACC)
14201# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14202!$acc loop seq
14203# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14204#elif defined(MFC_OpenMP)
14205# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14206
14207# 2730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14208#endif
14209 do i = eqn_idx%adv%beg, eqn_idx%adv%end
14210 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
14211 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
14212 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
14213 end do
14214
14215 ! Advection velocity source: interface velocity for volume fraction transport
14216
14217# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14218#if defined(MFC_OpenACC)
14219# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14220!$acc loop seq
14221# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14222#elif defined(MFC_OpenMP)
14223# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14224
14225# 2738 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14226#endif
14227 do i = 1, num_dims
14228 vel_src_rsx_vf(j, k, l, &
14229 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
14230 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
14231
14232 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
14233 end do
14234
14235 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
14236
14237 ! Add advection flux for bubble variables
14238
14239# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14240#if defined(MFC_OpenACC)
14241# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14242!$acc loop seq
14243# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14244#elif defined(MFC_OpenMP)
14245# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14246
14247# 2750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14248#endif
14249 do i = eqn_idx%bub%beg, eqn_idx%bub%end
14250 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
14251 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
14252 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k, l + 1, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
14253 end do
14254
14255 if (qbmm) then
14256 flux_rsx_vf(j, k, l, &
14257 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
14258 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
14259 end if
14260
14261 if (adv_n) then
14262 flux_rsx_vf(j, k, l, &
14263 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
14264 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
14265 end if
14266
14267 ! Geometrical source flux for cylindrical coordinates
14268# 2792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14269# 2793 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14270 if (grid_geometry == 3) then
14271
14272# 2794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14273#if defined(MFC_OpenACC)
14274# 2794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14275!$acc loop seq
14276# 2794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14277#elif defined(MFC_OpenMP)
14278# 2794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14279
14280# 2794 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14281#endif
14282 do i = 1, sys_size
14283 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
14284 end do
14285
14286 flux_gsrc_rsx_vf(j, k, l, &
14287 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1) &
14288 & ) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
14289 & *vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
14290 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
14291 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
14292 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
14293 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
14294 end if
14295# 2809 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14296 end do
14297 end do
14298 end do
14299
14300# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14301#if defined(MFC_OpenACC)
14302# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14303!$acc end parallel loop
14304# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14305#elif defined(MFC_OpenMP)
14306# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14307
14308# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14309!$omp end target teams loop
14310# 2812 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14311#endif
14312 else
14313 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
14314
14315# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14316
14317# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14318#if defined(MFC_OpenACC)
14319# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14320!$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, xi_L_m1, xi_R_m1, 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)
14321# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14322#elif defined(MFC_OpenMP)
14323# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14324
14325# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14326
14327# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14328
14329# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14330!$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, xi_L_m1, xi_R_m1, 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)
14331# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14332#endif
14333# 2824 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14334 do l = is1%beg, is1%end
14335 do k = is2%beg, is2%end
14336 do j = is3%beg, is3%end
14337 vel_l_rms = 0._wp; vel_r_rms = 0._wp
14338 rho_l = 0._wp; rho_r = 0._wp
14339 gamma_l = 0._wp; gamma_r = 0._wp
14340 pi_inf_l = 0._wp; pi_inf_r = 0._wp
14341 qv_l = 0._wp; qv_r = 0._wp
14342 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
14343
14344
14345# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14346#if defined(MFC_OpenACC)
14347# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14348!$acc loop seq
14349# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14350#elif defined(MFC_OpenMP)
14351# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14352
14353# 2834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14354#endif
14355 do i = 1, num_fluids
14356 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
14357 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
14358 end do
14359
14360
14361# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14362#if defined(MFC_OpenACC)
14363# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14364!$acc loop seq
14365# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14366#elif defined(MFC_OpenMP)
14367# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14368
14369# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14370#endif
14371 do i = 1, num_dims
14372 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
14373 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
14374 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
14375 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
14376 end do
14377
14378 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
14379 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
14380
14381 ! Change this by splitting it into the cases present in the bubbles_euler
14382 if (mpp_lim) then
14383
14384# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14385#if defined(MFC_OpenACC)
14386# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14387!$acc loop seq
14388# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14389#elif defined(MFC_OpenMP)
14390# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14391
14392# 2853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14393#endif
14394 do i = 1, num_fluids
14395 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
14396 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
14397 & eqn_idx%E + i)), 1._wp)
14398 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
14399 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
14400 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
14401 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
14402 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
14403 end do
14404
14405
14406# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14407#if defined(MFC_OpenACC)
14408# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14409!$acc loop seq
14410# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14411#elif defined(MFC_OpenMP)
14412# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14413
14414# 2865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14415#endif
14416 do i = 1, num_fluids
14417 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
14418 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
14419 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
14420 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
14421 end do
14422 end if
14423
14424
14425# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14426#if defined(MFC_OpenACC)
14427# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14428!$acc loop seq
14429# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14430#elif defined(MFC_OpenMP)
14431# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14432
14433# 2874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14434#endif
14435 do i = 1, num_fluids
14436 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
14437 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
14438 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
14439 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
14440
14441 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
14442 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
14443 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
14444 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
14445 end do
14446
14447 re_max = 0
14448 if (re_size(1) > 0) re_max = 1
14449 if (re_size(2) > 0) re_max = 2
14450
14451 if (viscous) then
14452
14453# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14454#if defined(MFC_OpenACC)
14455# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14456!$acc loop seq
14457# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14458#elif defined(MFC_OpenMP)
14459# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14460
14461# 2892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14462#endif
14463 do i = 1, re_max
14464 re_l(i) = 0._wp
14465 re_r(i) = 0._wp
14466
14467
14468# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14469#if defined(MFC_OpenACC)
14470# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14471!$acc loop seq
14472# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14473#elif defined(MFC_OpenMP)
14474# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14475
14476# 2897 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14477#endif
14478 do q = 1, re_size(i)
14479 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
14480 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
14481 end do
14482
14483 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
14484 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
14485 end do
14486 end if
14487
14488 if (chemistry) then
14489 c_sum_yi_phi = 0.0_wp
14490
14491# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14492#if defined(MFC_OpenACC)
14493# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14494!$acc loop seq
14495# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14496#elif defined(MFC_OpenMP)
14497# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14498
14499# 2910 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14500#endif
14501 do i = eqn_idx%species%beg, eqn_idx%species%end
14502 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
14503 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
14504 end do
14505
14506 call get_mixture_molecular_weight(ys_l, mw_l)
14507 call get_mixture_molecular_weight(ys_r, mw_r)
14508
14509 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
14510 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
14511
14512 r_gas_l = gas_constant/mw_l
14513 r_gas_r = gas_constant/mw_r
14514
14515 t_l = pres_l/rho_l/r_gas_l
14516 t_r = pres_r/rho_r/r_gas_r
14517
14518 call get_species_specific_heats_r(t_l, cp_il)
14519 call get_species_specific_heats_r(t_r, cp_ir)
14520
14521 if (chem_params%gamma_method == 1) then
14522 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
14523 gamma_il = cp_il/(cp_il - 1.0_wp)
14524 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
14525
14526 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
14527 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
14528 else if (chem_params%gamma_method == 2) then
14529 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
14530 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
14531 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
14532 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
14533 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
14534
14535 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
14536 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
14537 end if
14538
14539 call get_mixture_energy_mass(t_l, ys_l, e_l)
14540 call get_mixture_energy_mass(t_r, ys_r, e_r)
14541
14542 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
14543 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
14544 h_l = (e_l + pres_l)/rho_l
14545 h_r = (e_r + pres_r)/rho_r
14546 else
14547 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
14548 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
14549
14550 h_l = (e_l + pres_l)/rho_l
14551 h_r = (e_r + pres_r)/rho_r
14552 end if
14553
14554 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
14555 if (hypoelasticity) then
14556
14557# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14558#if defined(MFC_OpenACC)
14559# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14560!$acc loop seq
14561# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14562#elif defined(MFC_OpenMP)
14563# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14564
14565# 2966 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14566#endif
14567 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
14568 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
14569 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
14570 end do
14571 g_l = 0._wp
14572 g_r = 0._wp
14573
14574# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14575#if defined(MFC_OpenACC)
14576# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14577!$acc loop seq
14578# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14579#elif defined(MFC_OpenMP)
14580# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14581
14582# 2973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14583#endif
14584 do i = 1, num_fluids
14585 g_l = g_l + alpha_l(i)*gs_rs(i)
14586 g_r = g_r + alpha_r(i)*gs_rs(i)
14587 end do
14588
14589# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14590#if defined(MFC_OpenACC)
14591# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14592!$acc loop seq
14593# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14594#elif defined(MFC_OpenMP)
14595# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14596
14597# 2978 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14598#endif
14599 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
14600 ! Elastic contribution to energy if G large enough
14601 if ((g_l > verysmall) .and. (g_r > verysmall)) then
14602 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
14603 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
14604 ! Additional terms in 2D and 3D
14605 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
14606 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
14607 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
14608 end if
14609 end if
14610 end do
14611 end if
14612
14613 ! Hyperelastic stress contribution: strain energy added to total energy
14614 if (hyperelasticity) then
14615
14616# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14617#if defined(MFC_OpenACC)
14618# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14619!$acc loop seq
14620# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14621#elif defined(MFC_OpenMP)
14622# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14623
14624# 2995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14625#endif
14626 do i = 1, num_dims
14627 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
14628 xi_field_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%beg - 1 + i)
14629 end do
14630 g_l = 0._wp
14631 g_r = 0._wp
14632
14633# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14634#if defined(MFC_OpenACC)
14635# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14636!$acc loop seq
14637# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14638#elif defined(MFC_OpenMP)
14639# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14640
14641# 3002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14642#endif
14643 do i = 1, num_fluids
14644 ! Mixture left and right shear modulus
14645 g_l = g_l + alpha_l(i)*gs_rs(i)
14646 g_r = g_r + alpha_r(i)*gs_rs(i)
14647 end do
14648 ! Elastic contribution to energy if G large enough
14649 if (g_l > verysmall .and. g_r > verysmall) then
14650 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
14651 e_r = e_r + g_r*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%end + 1)
14652 end if
14653
14654# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14655#if defined(MFC_OpenACC)
14656# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14657!$acc loop seq
14658# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14659#elif defined(MFC_OpenMP)
14660# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14661
14662# 3013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14663#endif
14664 do i = 1, b_size - 1
14665 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
14666 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
14667 end do
14668 end if
14669
14670 h_l = (e_l + pres_l)/rho_l
14671 h_r = (e_r + pres_r)/rho_r
14672
14673 if (avg_state == 1) then
14674# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14675 rho_avg = sqrt(rho_l*rho_r)
14676# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14677
14678# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14679 vel_avg_rms = 0._wp
14680# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14681
14682# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14683
14684# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14685#if defined(MFC_OpenACC)
14686# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14687!$acc loop seq
14688# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14689#elif defined(MFC_OpenMP)
14690# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14691
14692# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14693#endif
14694# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14695 do i = 1, num_vels
14696# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14697 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
14698# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14699 end do
14700# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14701
14702# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14703 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
14704# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14705
14706# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14707 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
14708# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14709
14710# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14711 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
14712# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14713
14714# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14715 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
14716# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14717
14718# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14719 if (chemistry) then
14720# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14721 eps = 0.001_wp
14722# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14723 call get_species_enthalpies_rt(t_l, h_il)
14724# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14725 call get_species_enthalpies_rt(t_r, h_ir)
14726# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14727 h_il = h_il*gas_constant/molecular_weights*t_l
14728# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14729 h_ir = h_ir*gas_constant/molecular_weights*t_r
14730# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14731 call get_species_specific_heats_r(t_l, cp_il)
14732# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14733 call get_species_specific_heats_r(t_r, cp_ir)
14734# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14735
14736# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14737 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
14738# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14739 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
14740# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14741 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
14742# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14743 if (abs(t_l - t_r) < eps) then
14744# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14745 ! Case when T_L and T_R are very close
14746# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14747 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
14748# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14749 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
14750# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14751 & - gas_constant/molecular_weights(:)))
14752# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14753 else
14754# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14755 ! Normal calculation when T_L and T_R are sufficiently different
14756# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14757 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
14758# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14759 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
14760# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14761 end if
14762# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14763 gamma_avg = cp_avg/cv_avg
14764# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14765
14766# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14767 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
14768# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14769 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
14770# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14771 end if
14772# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14773 end if
14774# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14775
14776# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14777 if (avg_state == 2) then
14778# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14779 rho_avg = 5.e-1_wp*(rho_l + rho_r)
14780# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14781 vel_avg_rms = 0._wp
14782# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14783
14784# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14785#if defined(MFC_OpenACC)
14786# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14787!$acc loop seq
14788# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14789#elif defined(MFC_OpenMP)
14790# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14791
14792# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14793#endif
14794# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14795 do i = 1, num_vels
14796# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14797 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
14798# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14799 end do
14800# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14801
14802# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14803 h_avg = 5.e-1_wp*(h_l + h_r)
14804# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14805 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
14806# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14807 qv_avg = 5.e-1_wp*(qv_l + qv_r)
14808# 3023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14809 end if
14810
14811 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
14812 & c_l, qv_l)
14813
14814 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
14815 & c_r, qv_r)
14816
14817 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
14818 ! variables are placeholders to call the subroutine.
14819 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
14820 & c_sum_yi_phi, c_avg, qv_avg)
14821
14822 if (viscous) then
14823 if (chemistry) then
14824 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
14825 end if
14826
14827# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14828#if defined(MFC_OpenACC)
14829# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14830!$acc loop seq
14831# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14832#elif defined(MFC_OpenMP)
14833# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14834
14835# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14836#endif
14837 do i = 1, 2
14838 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
14839 end do
14840 end if
14841
14842 ! Low Mach correction
14843 if (low_mach == 2) then
14844 if (riemann_solver == 1 .or. riemann_solver == 5) then
14845# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14846 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14847# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14848 pcorr = 0._wp
14849# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14850
14851# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14852 if (low_mach == 1) then
14853# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14854 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14855# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14856 end if
14857# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14858 else if (riemann_solver == 2) then
14859# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14860 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14861# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14862 pcorr = 0._wp
14863# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14864
14865# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14866 if (low_mach == 1) then
14867# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14868 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))) &
14869# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14870 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14871# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14872 else if (low_mach == 2) then
14873# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14874 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))))
14875# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14876 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))))
14877# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14878 vel_l(dir_idx(1)) = vel_l_tmp
14879# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14880 vel_r(dir_idx(1)) = vel_r_tmp
14881# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14882 end if
14883# 3048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14884 end if
14885 end if
14886
14887 if (wave_speeds == 1) then
14888 if (elasticity) then
14889 ! Elastic wave speed, Rodriguez et al. JCP (2019)
14890 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) &
14891 & ))/rho_l), &
14892 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
14893 & + tau_e_r(dir_idx_tau(1)))/rho_r))
14894 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) &
14895 & ))/rho_r), &
14896 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
14897 & + tau_e_l(dir_idx_tau(1)))/rho_l))
14898 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
14899 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
14900 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
14901 & - vel_r(dir_idx(1))))
14902 else
14903 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
14904 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
14905 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
14906 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
14907 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
14908 end if
14909 else if (wave_speeds == 2) then
14910 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
14911
14912 pres_sr = pres_sl
14913
14914 ! Low Mach correction: Thornber et al. JCP (2008)
14915 ms_l = max(1._wp, &
14916 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
14917 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
14918 ms_r = max(1._wp, &
14919 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
14920 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
14921
14922 s_l = vel_l(dir_idx(1)) - c_l*ms_l
14923 s_r = vel_r(dir_idx(1)) + c_r*ms_r
14924
14925 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
14926 end if
14927
14928 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
14929 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
14930
14931 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
14932 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
14933 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
14934 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
14935 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
14936 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
14937
14938 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
14939 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
14940 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
14941
14942 ! Low Mach correction
14943 if (low_mach == 1) then
14944 if (riemann_solver == 1 .or. riemann_solver == 5) then
14945# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14946 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14947# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14948 pcorr = 0._wp
14949# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14950
14951# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14952 if (low_mach == 1) then
14953# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14954 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14955# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14956 end if
14957# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14958 else if (riemann_solver == 2) then
14959# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14960 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14961# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14962 pcorr = 0._wp
14963# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14964
14965# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14966 if (low_mach == 1) then
14967# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14968 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))) &
14969# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14970 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14971# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14972 else if (low_mach == 2) then
14973# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14974 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))))
14975# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14976 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))))
14977# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14978 vel_l(dir_idx(1)) = vel_l_tmp
14979# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14980 vel_r(dir_idx(1)) = vel_r_tmp
14981# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14982 end if
14983# 3108 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14984 end if
14985 else
14986 pcorr = 0._wp
14987 end if
14988
14989 ! COMPUTING THE HLLC FLUXES MASS FLUX.
14990
14991# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14992#if defined(MFC_OpenACC)
14993# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14994!$acc loop seq
14995# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14996#elif defined(MFC_OpenMP)
14997# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14998
14999# 3114 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15000#endif
15001 do i = 1, eqn_idx%cont%end
15002 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
15003 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
15004 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
15005 end do
15006
15007 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
15008 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
15009
15010# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15011#if defined(MFC_OpenACC)
15012# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15013!$acc loop seq
15014# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15015#elif defined(MFC_OpenMP)
15016# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15017
15018# 3123 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15019#endif
15020 do i = 1, num_dims
15021 flux_rsx_vf(j, k, l, &
15022 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
15023 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
15024 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
15025 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
15026 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
15027 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
15028 end do
15029
15030 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
15031 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
15032 flux_rsx_vf(j, k, l, &
15033 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(e_l*xi_l_m1 + xi_l*(s_s &
15034 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
15035 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
15036 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
15037 & *(s_p/s_r)*pcorr*s_s
15038
15039 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
15040 if (elasticity) then
15041 flux_ene_e = 0._wp
15042
15043# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15044#if defined(MFC_OpenACC)
15045# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15046!$acc loop seq
15047# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15048#elif defined(MFC_OpenMP)
15049# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15050
15051# 3146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15052#endif
15053 do i = 1, num_dims
15054 ! MOMENTUM ELASTIC FLUX.
15055 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
15056 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
15057 & - xi_p*tau_e_r(dir_idx_tau(i))
15058 ! ENERGY ELASTIC FLUX.
15059 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
15060 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
15061 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
15062 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
15063 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
15064 end do
15065 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
15066 end if
15067
15068 ! HYPOELASTIC STRESS EVOLUTION FLUX.
15069 if (hypoelasticity) then
15070
15071# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15072#if defined(MFC_OpenACC)
15073# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15074!$acc loop seq
15075# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15076#elif defined(MFC_OpenMP)
15077# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15078
15079# 3164 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15080#endif
15081 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
15082 flux_rsx_vf(j, k, l, &
15083 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
15084 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
15085 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
15086 end do
15087 end if
15088
15089 ! VOLUME FRACTION FLUX.
15090
15091# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15092#if defined(MFC_OpenACC)
15093# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15094!$acc loop seq
15095# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15096#elif defined(MFC_OpenMP)
15097# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15098
15099# 3174 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15100#endif
15101 do i = eqn_idx%adv%beg, eqn_idx%adv%end
15102 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
15103 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
15104 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
15105 end do
15106
15107 ! VOLUME FRACTION SOURCE FLUX.
15108
15109# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15110#if defined(MFC_OpenACC)
15111# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15112!$acc loop seq
15113# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15114#elif defined(MFC_OpenMP)
15115# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15116
15117# 3182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15118#endif
15119 do i = 1, num_dims
15120 vel_src_rsx_vf(j, k, l, &
15121 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
15122 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
15123 end do
15124
15125 ! COLOR FUNCTION FLUX
15126 if (surface_tension) then
15127 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
15128 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
15129 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
15130 end if
15131
15132 ! Hyperelastic reference map flux for material deformation tracking
15133 if (hyperelasticity) then
15134
15135# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15136#if defined(MFC_OpenACC)
15137# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15138!$acc loop seq
15139# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15140#elif defined(MFC_OpenMP)
15141# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15142
15143# 3198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15144#endif
15145 do i = 1, num_dims
15146 flux_rsx_vf(j, k, l, &
15147 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
15148 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
15149 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
15150 end do
15151 end if
15152
15153 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
15154
15155 if (chemistry) then
15156
15157# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15158#if defined(MFC_OpenACC)
15159# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15160!$acc loop seq
15161# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15162#elif defined(MFC_OpenMP)
15163# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15164
15165# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15166#endif
15167 do i = eqn_idx%species%beg, eqn_idx%species%end
15168 y_l = ql_prim_rsx_vf(j, k, l, i)
15169 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
15170
15171 flux_rsx_vf(j, k, l, &
15172 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
15173 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
15174 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
15175 end do
15176 end if
15177
15178 ! Geometrical source flux for cylindrical coordinates
15179# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15180# 3246 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15181 if (grid_geometry == 3) then
15182
15183# 3247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15184#if defined(MFC_OpenACC)
15185# 3247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15186!$acc loop seq
15187# 3247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15188#elif defined(MFC_OpenMP)
15189# 3247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15190
15191# 3247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15192#endif
15193 do i = 1, sys_size
15194 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
15195 end do
15196
15197 flux_gsrc_rsx_vf(j, k, l, &
15198 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1) &
15199 & ) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
15200 & *vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
15201 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
15202 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
15203 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
15204 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
15205 end if
15206# 3262 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15207 end do
15208 end do
15209 end do
15210
15211# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15212#if defined(MFC_OpenACC)
15213# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15214!$acc end parallel loop
15215# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15216#elif defined(MFC_OpenMP)
15217# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15218
15219# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15220!$omp end target teams loop
15221# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15222#endif
15223 end if
15224 end if
15225# 3269 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15226 ! Computing HLLC flux and source flux for Euler system of equations
15227
15228 if (viscous) then
15229 if (weno_re_flux) then
15230 call s_compute_viscous_source_flux(ql_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15231 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15232 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15233 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15234 & qr_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15235 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15236 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15237 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, &
15238 & iy, iz)
15239 else
15240 call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15241 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15242 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15243 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15244 & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15245 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15246 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15247 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, &
15248 & iy, iz)
15249 end if
15250 end if
15251
15252 if (surface_tension) then
15253 call s_compute_capillary_source_flux(vel_src_rsx_vf, flux_src_vf, norm_dir, isx, isy, isz)
15254 end if
15255
15256 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
15257
15258 end subroutine s_hllc_riemann_solver
15259
15260 !> HLLD Riemann solver for MHD, Miyoshi & Kusano JCP (2005)
15261 subroutine s_hlld_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, &
15262
15263 & dqL_prim_dz_vf, qL_prim_vf, qR_prim_rsx_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, qR_prim_vf, q_prim_vf, &
15264 & flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
15265
15266 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, qr_prim_rsx_vf
15267 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
15268 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
15269
15270 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
15271 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
15272 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
15273 integer, intent(in) :: norm_dir
15274 type(int_bounds_info), intent(in) :: ix, iy, iz
15275
15276 ! Local variables:
15277
15278# 3324 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15279 real(wp), dimension(num_fluids) :: alpha_l, alpha_r, alpha_rho_l, alpha_rho_r
15280# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15281 type(riemann_states_vec3) :: vel
15282 type(riemann_states) :: rho, pres, e, h_no_mag
15283 type(riemann_states) :: gamma, pi_inf, qv
15284 type(riemann_states) :: vel_rms
15285 type(riemann_states_vec3) :: b
15286 type(riemann_states) :: c, c_fast, pres_mag
15287
15288 ! HLLD speeds and intermediate state variables:
15289 real(wp) :: s_l, s_r, s_m, s_starl, s_starr
15290 real(wp) :: ptot_l, ptot_r, p_star, rhol_star, rhor_star, e_starl, e_starr
15291 real(wp), dimension(7) :: u_l, u_r, u_starl, u_starr, u_doublel, u_doubler
15292 real(wp), dimension(7) :: f_l, f_r, f_starl, f_starr, f_hlld
15293
15294 ! 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
15295 ! normal velocity, and x is the normal direction Note: Bx is omitted as the magnetic flux is always zero in the normal
15296 ! direction
15297
15298 real(wp) :: sqrt_rhol_star, sqrt_rhor_star, denom_ds, sign_bx
15299 real(wp) :: vl_star, vr_star, wl_star, wr_star
15300 real(wp) :: v_double, w_double, by_double, bz_double, e_doublel, e_doubler, e_double
15301 integer :: i, j, k, l
15302
15303 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
15304 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
15305
15306 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
15307
15308# 3357 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15309# 3358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15310# 3359 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15311 if (norm_dir == 1) then
15312
15313# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15314
15315# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15316#if defined(MFC_OpenACC)
15317# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15318!$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)
15319# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15320#elif defined(MFC_OpenMP)
15321# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15322
15323# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15324
15325# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15326
15327# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15328!$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)
15329# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15330#endif
15331# 3366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15332 do l = is3%beg, is3%end
15333 do k = is2%beg, is2%end
15334 do j = is1%beg, is1%end
15335 ! (1) Extract the left/right primitive states
15336 do i = 1, eqn_idx%cont%end
15337 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
15338 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
15339 end do
15340
15341 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
15342 do i = 1, num_vels
15343 vel%L(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i))
15344 vel%R(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + dir_idx(i))
15345 end do
15346
15347 vel_rms%L = sum(vel%L**2._wp)
15348 vel_rms%R = sum(vel%R**2._wp)
15349
15350 do i = 1, num_fluids
15351 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
15352 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
15353 end do
15354
15355 pres%L = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
15356 pres%R = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
15357
15358 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
15359 if (mhd) then
15360 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
15361 b%L = [bx0, ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg), ql_prim_rsx_vf(j, k, l, &
15362 & eqn_idx%B%beg + 1)]
15363 b%R = [bx0, qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg), qr_prim_rsx_vf(j + 1, k, l, &
15364 & eqn_idx%B%beg + 1)]
15365 else ! 2D/3D: Bx, By, Bz as variables
15366 b%L = [ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1), ql_prim_rsx_vf(j, k, l, &
15367 & eqn_idx%B%beg + dir_idx(2) - 1), ql_prim_rsx_vf(j, k, l, &
15368 & eqn_idx%B%beg + dir_idx(3) - 1)]
15369 b%R = [qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + dir_idx(1) - 1), &
15370 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + dir_idx(2) - 1), &
15371 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + dir_idx(3) - 1)]
15372 end if
15373 end if
15374
15375 ! Sum properties of all fluid components
15376 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
15377 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
15378
15379# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15380#if defined(MFC_OpenACC)
15381# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15382!$acc loop seq
15383# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15384#elif defined(MFC_OpenMP)
15385# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15386
15387# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15388#endif
15389 do i = 1, num_fluids
15390 rho%L = rho%L + alpha_rho_l(i)
15391 gamma%L = gamma%L + alpha_l(i)*gammas(i)
15392 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
15393 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
15394
15395 rho%R = rho%R + alpha_rho_r(i)
15396 gamma%R = gamma%R + alpha_r(i)*gammas(i)
15397 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
15398 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
15399 end do
15400
15401 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
15402 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
15403 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
15404 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
15405 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
15406 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
15407 h_no_mag%R = (e%R + pres%R - pres_mag%R)/rho%R
15408
15409 ! (2) Compute fast wave speeds
15410 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, &
15411 & 0._wp, c%L, qv%L)
15412 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, &
15413 & 0._wp, c%R, qv%R)
15414 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
15415 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
15416
15417 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
15418 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
15419 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
15420
15421 ptot_l = pres%L + pres_mag%L
15422 ptot_r = pres%R + pres_mag%R
15423
15424 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 &
15425 & - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
15426
15427 ! (4) Compute star state variables
15428 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
15429 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
15430 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
15431 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
15432 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
15433
15434 ! (5) Compute left/right state vectors and fluxes
15435 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
15436 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
15437 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
15438 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
15439
15440 ! Compute the left/right fluxes
15441 f_l(1) = u_l(2)
15442 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
15443 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
15444 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
15445 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))
15446
15447 f_r(1) = u_r(2)
15448 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
15449 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
15450 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
15451 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))
15452 ! HLLD star-state fluxes via HLL jump relation
15453 f_starl = f_l + s_l*(u_starl - u_l)
15454 f_starr = f_r + s_r*(u_starr - u_r)
15455 ! Alfven wave speeds bounding the rotational discontinuities
15456 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
15457 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
15458 ! HLLD double-star (intermediate) states across rotational discontinuities
15459 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
15460 vl_star = vel%L(2); wl_star = vel%L(3)
15461 vr_star = vel%R(2); wr_star = vel%R(3)
15462
15463 ! (6) Compute the double-star states [Miyoshi Eqns. (59)-(62)]
15464 denom_ds = sqrt_rhol_star + sqrt_rhor_star
15465 sign_bx = sign(1._wp, b%L(1))
15466 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
15467 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
15468 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star &
15469 & - vl_star)*sign_bx)/denom_ds
15470 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star &
15471 & - wl_star)*sign_bx)/denom_ds
15472
15473 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double &
15474 & + w_double*bz_double))*sign_bx
15475 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double &
15476 & + w_double*bz_double))*sign_bx
15477 e_double = 0.5_wp*(e_doublel + e_doubler)
15478
15479 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, &
15480 & e_double]
15481 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, &
15482 & e_double]
15483
15484 ! Select HLLD flux region
15485 if (0.0_wp <= s_l) then
15486 f_hlld = f_l
15487 else if (0.0_wp <= s_starl) then
15488 f_hlld = f_l + s_l*(u_starl - u_l)
15489 else if (0.0_wp <= s_m) then
15490 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
15491 else if (0.0_wp <= s_starr) then
15492 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
15493 else if (0.0_wp <= s_r) then
15494 f_hlld = f_r + s_r*(u_starr - u_r)
15495 else
15496 f_hlld = f_r
15497 end if
15498
15499 ! (12) Write HLLD flux to output arrays
15500 flux_rsx_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
15501 ! Momentum
15502 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(2)
15503 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(3)
15504 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(4)
15505 ! Magnetic field
15506 if (n == 0) then
15507 flux_rsx_vf(j, k, l, eqn_idx%B%beg) = f_hlld(5)
15508 flux_rsx_vf(j, k, l, eqn_idx%B%beg + 1) = f_hlld(6)
15509 else
15510 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1) = 0._wp
15511 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(2) - 1) = f_hlld(5)
15512 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(3) - 1) = f_hlld(6)
15513 end if
15514 ! Energy
15515 flux_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(7)
15516 ! Volume fractions
15517
15518# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15519#if defined(MFC_OpenACC)
15520# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15521!$acc loop seq
15522# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15523#elif defined(MFC_OpenMP)
15524# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15525
15526# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15527#endif
15528 do i = eqn_idx%adv%beg, eqn_idx%adv%end
15529 flux_rsx_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
15530 end do
15531
15532 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
15533 end do
15534 end do
15535 end do
15536
15537# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15538#if defined(MFC_OpenACC)
15539# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15540!$acc end parallel loop
15541# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15542#elif defined(MFC_OpenMP)
15543# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15544
15545# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15546!$omp end target teams loop
15547# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15548#endif
15549 end if
15550# 3357 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15551# 3358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15552# 3359 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15553 if (norm_dir == 2) then
15554
15555# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15556
15557# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15558#if defined(MFC_OpenACC)
15559# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15560!$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)
15561# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15562#elif defined(MFC_OpenMP)
15563# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15564
15565# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15566
15567# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15568
15569# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15570!$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)
15571# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15572#endif
15573# 3366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15574 do l = is3%beg, is3%end
15575 do k = is1%beg, is1%end
15576 do j = is2%beg, is2%end
15577 ! (1) Extract the left/right primitive states
15578 do i = 1, eqn_idx%cont%end
15579 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
15580 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
15581 end do
15582
15583 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
15584 do i = 1, num_vels
15585 vel%L(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i))
15586 vel%R(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + dir_idx(i))
15587 end do
15588
15589 vel_rms%L = sum(vel%L**2._wp)
15590 vel_rms%R = sum(vel%R**2._wp)
15591
15592 do i = 1, num_fluids
15593 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
15594 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
15595 end do
15596
15597 pres%L = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
15598 pres%R = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
15599
15600 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
15601 if (mhd) then
15602 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
15603 b%L = [bx0, ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg), ql_prim_rsx_vf(j, k, l, &
15604 & eqn_idx%B%beg + 1)]
15605 b%R = [bx0, qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg), qr_prim_rsx_vf(j, k + 1, l, &
15606 & eqn_idx%B%beg + 1)]
15607 else ! 2D/3D: Bx, By, Bz as variables
15608 b%L = [ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1), ql_prim_rsx_vf(j, k, l, &
15609 & eqn_idx%B%beg + dir_idx(2) - 1), ql_prim_rsx_vf(j, k, l, &
15610 & eqn_idx%B%beg + dir_idx(3) - 1)]
15611 b%R = [qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + dir_idx(1) - 1), &
15612 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + dir_idx(2) - 1), &
15613 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + dir_idx(3) - 1)]
15614 end if
15615 end if
15616
15617 ! Sum properties of all fluid components
15618 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
15619 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
15620
15621# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15622#if defined(MFC_OpenACC)
15623# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15624!$acc loop seq
15625# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15626#elif defined(MFC_OpenMP)
15627# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15628
15629# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15630#endif
15631 do i = 1, num_fluids
15632 rho%L = rho%L + alpha_rho_l(i)
15633 gamma%L = gamma%L + alpha_l(i)*gammas(i)
15634 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
15635 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
15636
15637 rho%R = rho%R + alpha_rho_r(i)
15638 gamma%R = gamma%R + alpha_r(i)*gammas(i)
15639 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
15640 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
15641 end do
15642
15643 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
15644 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
15645 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
15646 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
15647 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
15648 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
15649 h_no_mag%R = (e%R + pres%R - pres_mag%R)/rho%R
15650
15651 ! (2) Compute fast wave speeds
15652 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, &
15653 & 0._wp, c%L, qv%L)
15654 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, &
15655 & 0._wp, c%R, qv%R)
15656 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
15657 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
15658
15659 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
15660 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
15661 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
15662
15663 ptot_l = pres%L + pres_mag%L
15664 ptot_r = pres%R + pres_mag%R
15665
15666 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 &
15667 & - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
15668
15669 ! (4) Compute star state variables
15670 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
15671 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
15672 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
15673 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
15674 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
15675
15676 ! (5) Compute left/right state vectors and fluxes
15677 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
15678 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
15679 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
15680 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
15681
15682 ! Compute the left/right fluxes
15683 f_l(1) = u_l(2)
15684 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
15685 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
15686 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
15687 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))
15688
15689 f_r(1) = u_r(2)
15690 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
15691 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
15692 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
15693 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))
15694 ! HLLD star-state fluxes via HLL jump relation
15695 f_starl = f_l + s_l*(u_starl - u_l)
15696 f_starr = f_r + s_r*(u_starr - u_r)
15697 ! Alfven wave speeds bounding the rotational discontinuities
15698 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
15699 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
15700 ! HLLD double-star (intermediate) states across rotational discontinuities
15701 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
15702 vl_star = vel%L(2); wl_star = vel%L(3)
15703 vr_star = vel%R(2); wr_star = vel%R(3)
15704
15705 ! (6) Compute the double-star states [Miyoshi Eqns. (59)-(62)]
15706 denom_ds = sqrt_rhol_star + sqrt_rhor_star
15707 sign_bx = sign(1._wp, b%L(1))
15708 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
15709 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
15710 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star &
15711 & - vl_star)*sign_bx)/denom_ds
15712 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star &
15713 & - wl_star)*sign_bx)/denom_ds
15714
15715 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double &
15716 & + w_double*bz_double))*sign_bx
15717 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double &
15718 & + w_double*bz_double))*sign_bx
15719 e_double = 0.5_wp*(e_doublel + e_doubler)
15720
15721 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, &
15722 & e_double]
15723 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, &
15724 & e_double]
15725
15726 ! Select HLLD flux region
15727 if (0.0_wp <= s_l) then
15728 f_hlld = f_l
15729 else if (0.0_wp <= s_starl) then
15730 f_hlld = f_l + s_l*(u_starl - u_l)
15731 else if (0.0_wp <= s_m) then
15732 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
15733 else if (0.0_wp <= s_starr) then
15734 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
15735 else if (0.0_wp <= s_r) then
15736 f_hlld = f_r + s_r*(u_starr - u_r)
15737 else
15738 f_hlld = f_r
15739 end if
15740
15741 ! (12) Write HLLD flux to output arrays
15742 flux_rsx_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
15743 ! Momentum
15744 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(2)
15745 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(3)
15746 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(4)
15747 ! Magnetic field
15748 if (n == 0) then
15749 flux_rsx_vf(j, k, l, eqn_idx%B%beg) = f_hlld(5)
15750 flux_rsx_vf(j, k, l, eqn_idx%B%beg + 1) = f_hlld(6)
15751 else
15752 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1) = 0._wp
15753 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(2) - 1) = f_hlld(5)
15754 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(3) - 1) = f_hlld(6)
15755 end if
15756 ! Energy
15757 flux_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(7)
15758 ! Volume fractions
15759
15760# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15761#if defined(MFC_OpenACC)
15762# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15763!$acc loop seq
15764# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15765#elif defined(MFC_OpenMP)
15766# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15767
15768# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15769#endif
15770 do i = eqn_idx%adv%beg, eqn_idx%adv%end
15771 flux_rsx_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
15772 end do
15773
15774 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
15775 end do
15776 end do
15777 end do
15778
15779# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15780#if defined(MFC_OpenACC)
15781# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15782!$acc end parallel loop
15783# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15784#elif defined(MFC_OpenMP)
15785# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15786
15787# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15788!$omp end target teams loop
15789# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15790#endif
15791 end if
15792# 3357 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15793# 3358 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15794# 3359 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15795 if (norm_dir == 3) then
15796
15797# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15798
15799# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15800#if defined(MFC_OpenACC)
15801# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15802!$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)
15803# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15804#elif defined(MFC_OpenMP)
15805# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15806
15807# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15808
15809# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15810
15811# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15812!$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)
15813# 3360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15814#endif
15815# 3366 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15816 do l = is1%beg, is1%end
15817 do k = is2%beg, is2%end
15818 do j = is3%beg, is3%end
15819 ! (1) Extract the left/right primitive states
15820 do i = 1, eqn_idx%cont%end
15821 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
15822 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
15823 end do
15824
15825 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
15826 do i = 1, num_vels
15827 vel%L(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i))
15828 vel%R(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + dir_idx(i))
15829 end do
15830
15831 vel_rms%L = sum(vel%L**2._wp)
15832 vel_rms%R = sum(vel%R**2._wp)
15833
15834 do i = 1, num_fluids
15835 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
15836 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
15837 end do
15838
15839 pres%L = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
15840 pres%R = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
15841
15842 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
15843 if (mhd) then
15844 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
15845 b%L = [bx0, ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg), ql_prim_rsx_vf(j, k, l, &
15846 & eqn_idx%B%beg + 1)]
15847 b%R = [bx0, qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg), qr_prim_rsx_vf(j, k, l + 1, &
15848 & eqn_idx%B%beg + 1)]
15849 else ! 2D/3D: Bx, By, Bz as variables
15850 b%L = [ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1), ql_prim_rsx_vf(j, k, l, &
15851 & eqn_idx%B%beg + dir_idx(2) - 1), ql_prim_rsx_vf(j, k, l, &
15852 & eqn_idx%B%beg + dir_idx(3) - 1)]
15853 b%R = [qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + dir_idx(1) - 1), &
15854 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + dir_idx(2) - 1), &
15855 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + dir_idx(3) - 1)]
15856 end if
15857 end if
15858
15859 ! Sum properties of all fluid components
15860 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
15861 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
15862
15863# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15864#if defined(MFC_OpenACC)
15865# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15866!$acc loop seq
15867# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15868#elif defined(MFC_OpenMP)
15869# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15870
15871# 3412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15872#endif
15873 do i = 1, num_fluids
15874 rho%L = rho%L + alpha_rho_l(i)
15875 gamma%L = gamma%L + alpha_l(i)*gammas(i)
15876 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
15877 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
15878
15879 rho%R = rho%R + alpha_rho_r(i)
15880 gamma%R = gamma%R + alpha_r(i)*gammas(i)
15881 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
15882 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
15883 end do
15884
15885 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
15886 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
15887 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
15888 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
15889 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
15890 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
15891 h_no_mag%R = (e%R + pres%R - pres_mag%R)/rho%R
15892
15893 ! (2) Compute fast wave speeds
15894 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, &
15895 & 0._wp, c%L, qv%L)
15896 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, &
15897 & 0._wp, c%R, qv%R)
15898 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
15899 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
15900
15901 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
15902 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
15903 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
15904
15905 ptot_l = pres%L + pres_mag%L
15906 ptot_r = pres%R + pres_mag%R
15907
15908 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 &
15909 & - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
15910
15911 ! (4) Compute star state variables
15912 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
15913 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
15914 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
15915 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
15916 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
15917
15918 ! (5) Compute left/right state vectors and fluxes
15919 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
15920 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
15921 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
15922 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
15923
15924 ! Compute the left/right fluxes
15925 f_l(1) = u_l(2)
15926 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
15927 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
15928 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
15929 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))
15930
15931 f_r(1) = u_r(2)
15932 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
15933 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
15934 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
15935 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))
15936 ! HLLD star-state fluxes via HLL jump relation
15937 f_starl = f_l + s_l*(u_starl - u_l)
15938 f_starr = f_r + s_r*(u_starr - u_r)
15939 ! Alfven wave speeds bounding the rotational discontinuities
15940 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
15941 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
15942 ! HLLD double-star (intermediate) states across rotational discontinuities
15943 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
15944 vl_star = vel%L(2); wl_star = vel%L(3)
15945 vr_star = vel%R(2); wr_star = vel%R(3)
15946
15947 ! (6) Compute the double-star states [Miyoshi Eqns. (59)-(62)]
15948 denom_ds = sqrt_rhol_star + sqrt_rhor_star
15949 sign_bx = sign(1._wp, b%L(1))
15950 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
15951 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
15952 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star &
15953 & - vl_star)*sign_bx)/denom_ds
15954 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star &
15955 & - wl_star)*sign_bx)/denom_ds
15956
15957 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double &
15958 & + w_double*bz_double))*sign_bx
15959 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double &
15960 & + w_double*bz_double))*sign_bx
15961 e_double = 0.5_wp*(e_doublel + e_doubler)
15962
15963 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, &
15964 & e_double]
15965 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, &
15966 & e_double]
15967
15968 ! Select HLLD flux region
15969 if (0.0_wp <= s_l) then
15970 f_hlld = f_l
15971 else if (0.0_wp <= s_starl) then
15972 f_hlld = f_l + s_l*(u_starl - u_l)
15973 else if (0.0_wp <= s_m) then
15974 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
15975 else if (0.0_wp <= s_starr) then
15976 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
15977 else if (0.0_wp <= s_r) then
15978 f_hlld = f_r + s_r*(u_starr - u_r)
15979 else
15980 f_hlld = f_r
15981 end if
15982
15983 ! (12) Write HLLD flux to output arrays
15984 flux_rsx_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
15985 ! Momentum
15986 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(2)
15987 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(3)
15988 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(4)
15989 ! Magnetic field
15990 if (n == 0) then
15991 flux_rsx_vf(j, k, l, eqn_idx%B%beg) = f_hlld(5)
15992 flux_rsx_vf(j, k, l, eqn_idx%B%beg + 1) = f_hlld(6)
15993 else
15994 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1) = 0._wp
15995 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(2) - 1) = f_hlld(5)
15996 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(3) - 1) = f_hlld(6)
15997 end if
15998 ! Energy
15999 flux_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(7)
16000 ! Volume fractions
16001
16002# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16003#if defined(MFC_OpenACC)
16004# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16005!$acc loop seq
16006# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16007#elif defined(MFC_OpenMP)
16008# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16009
16010# 3541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16011#endif
16012 do i = eqn_idx%adv%beg, eqn_idx%adv%end
16013 flux_rsx_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
16014 end do
16015
16016 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
16017 end do
16018 end do
16019 end do
16020
16021# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16022#if defined(MFC_OpenACC)
16023# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16024!$acc end parallel loop
16025# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16026#elif defined(MFC_OpenMP)
16027# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16028
16029# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16030!$omp end target teams loop
16031# 3550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16032#endif
16033 end if
16034# 3553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16035
16036 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
16037
16038 end subroutine s_hlld_riemann_solver
16039
16040 !> Initialize the Riemann solvers module
16041 impure subroutine s_initialize_riemann_solvers_module
16042
16043 ! Allocating the variables that will be utilized to formulate the left, right, and average states of the Riemann problem, as
16044 ! well the Riemann problem solution
16045 integer :: i, j
16046
16047#ifdef MFC_DEBUG
16048# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16049 block
16050# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16051 use iso_fortran_env, only: output_unit
16052# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16053
16054# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16055 print *, 'm_riemann_solvers.fpp:3565: ', '@:ALLOCATE(Gs_rs(1:num_fluids))'
16056# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16057
16058# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16059 call flush (output_unit)
16060# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16061 end block
16062# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16063#endif
16064# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16065 allocate (gs_rs(1:num_fluids))
16066# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16067
16068# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16069
16070# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16071#if defined(MFC_OpenACC)
16072# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16073!$acc enter data create(Gs_rs)
16074# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16075#elif defined(MFC_OpenMP)
16076# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16077!$omp target enter data map(always,alloc:Gs_rs)
16078# 3565 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16079#endif
16080
16081 do i = 1, num_fluids
16082 gs_rs(i) = fluid_pp(i)%G
16083 end do
16084
16085# 3570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16086#if defined(MFC_OpenACC)
16087# 3570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16088!$acc update device(Gs_rs)
16089# 3570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16090#elif defined(MFC_OpenMP)
16091# 3570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16092!$omp target update to(Gs_rs)
16093# 3570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16094#endif
16095
16096 if (viscous) then
16097#ifdef MFC_DEBUG
16098# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16099 block
16100# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16101 use iso_fortran_env, only: output_unit
16102# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16103
16104# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16105 print *, 'm_riemann_solvers.fpp:3573: ', '@:ALLOCATE(Res_gs(1:2, 1:Re_size_max))'
16106# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16107
16108# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16109 call flush (output_unit)
16110# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16111 end block
16112# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16113#endif
16114# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16115 allocate (res_gs(1:2, 1:re_size_max))
16116# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16117
16118# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16119
16120# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16121#if defined(MFC_OpenACC)
16122# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16123!$acc enter data create(Res_gs)
16124# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16125#elif defined(MFC_OpenMP)
16126# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16127!$omp target enter data map(always,alloc:Res_gs)
16128# 3573 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16129#endif
16130 end if
16131
16132 if (viscous) then
16133 do i = 1, 2
16134 do j = 1, re_size(i)
16135 res_gs(i, j) = fluid_pp(re_idx(i, j))%Re(i)
16136 end do
16137 end do
16138
16139# 3582 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16140#if defined(MFC_OpenACC)
16141# 3582 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16142!$acc update device(Res_gs, Re_idx, Re_size)
16143# 3582 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16144#elif defined(MFC_OpenMP)
16145# 3582 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16146!$omp target update to(Res_gs, Re_idx, Re_size)
16147# 3582 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16148#endif
16149 end if
16150
16151
16152# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16153#if defined(MFC_OpenACC)
16154# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16155!$acc enter data copyin(is1, is2, is3, isx, isy, isz)
16156# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16157#elif defined(MFC_OpenMP)
16158# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16159!$omp target enter data map(to:is1, is2, is3, isx, isy, isz)
16160# 3585 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16161#endif
16162
16163 is1%beg = -1; is2%beg = 0; is3%beg = 0
16164 is1%end = m; is2%end = n; is3%end = p
16165
16166#ifdef MFC_DEBUG
16167# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16168 block
16169# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16170 use iso_fortran_env, only: output_unit
16171# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16172
16173# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16174 print *, 'm_riemann_solvers.fpp:3590: ', '@:ALLOCATE(flux_rsx_vf(-1:m, -1:n, -1:p, 1:sys_size))'
16175# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16176
16177# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16178 call flush (output_unit)
16179# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16180 end block
16181# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16182#endif
16183# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16184 allocate (flux_rsx_vf(-1:m, -1:n, -1:p, 1:sys_size))
16185# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16186
16187# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16188
16189# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16190#if defined(MFC_OpenACC)
16191# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16192!$acc enter data create(flux_rsx_vf)
16193# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16194#elif defined(MFC_OpenMP)
16195# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16196!$omp target enter data map(always,alloc:flux_rsx_vf)
16197# 3590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16198#endif
16199#ifdef MFC_DEBUG
16200# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16201 block
16202# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16203 use iso_fortran_env, only: output_unit
16204# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16205
16206# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16207 print *, 'm_riemann_solvers.fpp:3591: ', '@:ALLOCATE(flux_gsrc_rsx_vf(-1:m, -1:n, -1:p, 1:sys_size))'
16208# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16209
16210# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16211 call flush (output_unit)
16212# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16213 end block
16214# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16215#endif
16216# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16217 allocate (flux_gsrc_rsx_vf(-1:m, -1:n, -1:p, 1:sys_size))
16218# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16219
16220# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16221
16222# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16223#if defined(MFC_OpenACC)
16224# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16225!$acc enter data create(flux_gsrc_rsx_vf)
16226# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16227#elif defined(MFC_OpenMP)
16228# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16229!$omp target enter data map(always,alloc:flux_gsrc_rsx_vf)
16230# 3591 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16231#endif
16232#ifdef MFC_DEBUG
16233# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16234 block
16235# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16236 use iso_fortran_env, only: output_unit
16237# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16238
16239# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16240 print *, 'm_riemann_solvers.fpp:3592: ', '@:ALLOCATE(flux_src_rsx_vf(-1:m, -1:n, -1:p, eqn_idx%adv%beg:sys_size))'
16241# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16242
16243# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16244 call flush (output_unit)
16245# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16246 end block
16247# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16248#endif
16249# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16250 allocate (flux_src_rsx_vf(-1:m, -1:n, -1:p, eqn_idx%adv%beg:sys_size))
16251# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16252
16253# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16254
16255# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16256#if defined(MFC_OpenACC)
16257# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16258!$acc enter data create(flux_src_rsx_vf)
16259# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16260#elif defined(MFC_OpenMP)
16261# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16262!$omp target enter data map(always,alloc:flux_src_rsx_vf)
16263# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16264#endif
16265#ifdef MFC_DEBUG
16266# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16267 block
16268# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16269 use iso_fortran_env, only: output_unit
16270# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16271
16272# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16273 print *, 'm_riemann_solvers.fpp:3593: ', '@:ALLOCATE(vel_src_rsx_vf(-1:m, -1:n, -1:p, 1:num_vels))'
16274# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16275
16276# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16277 call flush (output_unit)
16278# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16279 end block
16280# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16281#endif
16282# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16283 allocate (vel_src_rsx_vf(-1:m, -1:n, -1:p, 1:num_vels))
16284# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16285
16286# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16287
16288# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16289#if defined(MFC_OpenACC)
16290# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16291!$acc enter data create(vel_src_rsx_vf)
16292# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16293#elif defined(MFC_OpenMP)
16294# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16295!$omp target enter data map(always,alloc:vel_src_rsx_vf)
16296# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16297#endif
16298 if (qbmm) then
16299#ifdef MFC_DEBUG
16300# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16301 block
16302# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16303 use iso_fortran_env, only: output_unit
16304# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16305
16306# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16307 print *, 'm_riemann_solvers.fpp:3595: ', '@:ALLOCATE(mom_sp_rsx_vf(-1:m+1, -1:n+1, -1:p+1, 1:4))'
16308# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16309
16310# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16311 call flush (output_unit)
16312# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16313 end block
16314# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16315#endif
16316# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16317 allocate (mom_sp_rsx_vf(-1:m+1, -1:n+1, -1:p+1, 1:4))
16318# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16319
16320# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16321
16322# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16323#if defined(MFC_OpenACC)
16324# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16325!$acc enter data create(mom_sp_rsx_vf)
16326# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16327#elif defined(MFC_OpenMP)
16328# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16329!$omp target enter data map(always,alloc:mom_sp_rsx_vf)
16330# 3595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16331#endif
16332 end if
16333
16334 if (viscous) then
16335#ifdef MFC_DEBUG
16336# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16337 block
16338# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16339 use iso_fortran_env, only: output_unit
16340# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16341
16342# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16343 print *, 'm_riemann_solvers.fpp:3599: ', '@:ALLOCATE(Re_avg_rsx_vf(-1:m, -1:n, -1:p, 1:2))'
16344# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16345
16346# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16347 call flush (output_unit)
16348# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16349 end block
16350# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16351#endif
16352# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16353 allocate (re_avg_rsx_vf(-1:m, -1:n, -1:p, 1:2))
16354# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16355
16356# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16357
16358# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16359#if defined(MFC_OpenACC)
16360# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16361!$acc enter data create(Re_avg_rsx_vf)
16362# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16363#elif defined(MFC_OpenMP)
16364# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16365!$omp target enter data map(always,alloc:Re_avg_rsx_vf)
16366# 3599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16367#endif
16368 end if
16369
16370 end subroutine s_initialize_riemann_solvers_module
16371
16372 !> Populate the left and right Riemann state variable buffers based on boundary conditions
16373 subroutine s_populate_riemann_states_variables_buffers(qL_prim_rsx_vf, dqL_prim_dx_vf, &
16374
16375 & dqL_prim_dy_vf, dqL_prim_dz_vf, qR_prim_rsx_vf, dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, norm_dir, ix, iy, iz)
16376
16377 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qR_prim_rsx_vf
16378 type(scalar_field), allocatable, dimension(:), intent(inout) :: dqL_prim_dx_vf, dqR_prim_dx_vf, dqL_prim_dy_vf, &
16379 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
16380
16381 integer, intent(in) :: norm_dir
16382 type(int_bounds_info), intent(in) :: ix, iy, iz
16383 integer :: i, j, k, l !< Generic loop iterator
16384
16385 if (norm_dir == 1) then
16386 is1 = ix; is2 = iy; is3 = iz
16387 dir_idx = (/1, 2, 3/); dir_flg = (/1._wp, 0._wp, 0._wp/)
16388 else if (norm_dir == 2) then
16389 is1 = iy; is2 = ix; is3 = iz
16390 dir_idx = (/2, 1, 3/); dir_flg = (/0._wp, 1._wp, 0._wp/)
16391 else
16392 is1 = iz; is2 = iy; is3 = ix
16393 dir_idx = (/3, 1, 2/); dir_flg = (/0._wp, 0._wp, 1._wp/)
16394 end if
16395
16396
16397# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16398#if defined(MFC_OpenACC)
16399# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16400!$acc update device(is1, is2, is3)
16401# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16402#elif defined(MFC_OpenMP)
16403# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16404!$omp target update to(is1, is2, is3)
16405# 3628 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16406#endif
16407
16408 if (elasticity) then
16409 if (norm_dir == 1) then
16410 dir_idx_tau = (/1, 2, 4/)
16411 else if (norm_dir == 2) then
16412 dir_idx_tau = (/3, 2, 5/)
16413 else
16414 dir_idx_tau = (/6, 4, 5/)
16415 end if
16416 end if
16417
16418 isx = ix; isy = iy; isz = iz
16419 ! for stuff in the same module
16420
16421# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16422#if defined(MFC_OpenACC)
16423# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16424!$acc update device(isx, isy, isz)
16425# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16426#elif defined(MFC_OpenMP)
16427# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16428!$omp target update to(isx, isy, isz)
16429# 3642 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16430#endif
16431 ! for stuff in different modules
16432
16433# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16434#if defined(MFC_OpenACC)
16435# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16436!$acc update device(dir_idx, dir_flg, dir_idx_tau)
16437# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16438#elif defined(MFC_OpenMP)
16439# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16440!$omp target update to(dir_idx, dir_flg, dir_idx_tau)
16441# 3644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16442#endif
16443
16444 ! Population of Buffers in x-direction
16445 if (norm_dir == 1) then
16446 if (bc_x%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
16447
16448# 3649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16449
16450# 3649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16451#if defined(MFC_OpenACC)
16452# 3649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16453!$acc parallel loop collapse(3) gang vector default(present)
16454# 3649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16455#elif defined(MFC_OpenMP)
16456# 3649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16457
16458# 3649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16459
16460# 3649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16461
16462# 3649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16463!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16464# 3649 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16465#endif
16466 do i = 1, sys_size
16467 do l = is3%beg, is3%end
16468 do k = is2%beg, is2%end
16469 ql_prim_rsx_vf(-1, k, l, i) = qr_prim_rsx_vf(0, k, l, i)
16470 end do
16471 end do
16472 end do
16473
16474# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16475#if defined(MFC_OpenACC)
16476# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16477!$acc end parallel loop
16478# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16479#elif defined(MFC_OpenMP)
16480# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16481
16482# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16483!$omp end target teams loop
16484# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16485#endif
16486
16487 if (viscous) then
16488
16489# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16490
16491# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16492#if defined(MFC_OpenACC)
16493# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16494!$acc parallel loop collapse(3) gang vector default(present)
16495# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16496#elif defined(MFC_OpenMP)
16497# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16498
16499# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16500
16501# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16502
16503# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16504!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16505# 3660 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16506#endif
16507 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16508 do l = isz%beg, isz%end
16509 do k = isy%beg, isy%end
16510 dql_prim_dx_vf(i)%sf(-1, k, l) = dqr_prim_dx_vf(i)%sf(0, k, l)
16511 end do
16512 end do
16513 end do
16514
16515# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16516#if defined(MFC_OpenACC)
16517# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16518!$acc end parallel loop
16519# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16520#elif defined(MFC_OpenMP)
16521# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16522
16523# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16524!$omp end target teams loop
16525# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16526#endif
16527
16528 if (n > 0) then
16529
16530# 3671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16531
16532# 3671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16533#if defined(MFC_OpenACC)
16534# 3671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16535!$acc parallel loop collapse(3) gang vector default(present)
16536# 3671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16537#elif defined(MFC_OpenMP)
16538# 3671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16539
16540# 3671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16541
16542# 3671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16543
16544# 3671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16545!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16546# 3671 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16547#endif
16548 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16549 do l = isz%beg, isz%end
16550 do k = isy%beg, isy%end
16551 dql_prim_dy_vf(i)%sf(-1, k, l) = dqr_prim_dy_vf(i)%sf(0, k, l)
16552 end do
16553 end do
16554 end do
16555
16556# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16557#if defined(MFC_OpenACC)
16558# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16559!$acc end parallel loop
16560# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16561#elif defined(MFC_OpenMP)
16562# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16563
16564# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16565!$omp end target teams loop
16566# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16567#endif
16568
16569 if (p > 0) then
16570
16571# 3682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16572
16573# 3682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16574#if defined(MFC_OpenACC)
16575# 3682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16576!$acc parallel loop collapse(3) gang vector default(present)
16577# 3682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16578#elif defined(MFC_OpenMP)
16579# 3682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16580
16581# 3682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16582
16583# 3682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16584
16585# 3682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16586!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16587# 3682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16588#endif
16589 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16590 do l = isz%beg, isz%end
16591 do k = isy%beg, isy%end
16592 dql_prim_dz_vf(i)%sf(-1, k, l) = dqr_prim_dz_vf(i)%sf(0, k, l)
16593 end do
16594 end do
16595 end do
16596
16597# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16598#if defined(MFC_OpenACC)
16599# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16600!$acc end parallel loop
16601# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16602#elif defined(MFC_OpenMP)
16603# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16604
16605# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16606!$omp end target teams loop
16607# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16608#endif
16609 end if
16610 end if
16611 end if
16612 end if
16613
16614 if (bc_x%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
16615
16616
16617# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16618
16619# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16620#if defined(MFC_OpenACC)
16621# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16622!$acc parallel loop collapse(3) gang vector default(present)
16623# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16624#elif defined(MFC_OpenMP)
16625# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16626
16627# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16628
16629# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16630
16631# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16632!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16633# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16634#endif
16635 do i = 1, sys_size
16636 do l = is3%beg, is3%end
16637 do k = is2%beg, is2%end
16638 qr_prim_rsx_vf(m + 1, k, l, i) = ql_prim_rsx_vf(m, k, l, i)
16639 end do
16640 end do
16641 end do
16642
16643# 3706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16644#if defined(MFC_OpenACC)
16645# 3706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16646!$acc end parallel loop
16647# 3706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16648#elif defined(MFC_OpenMP)
16649# 3706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16650
16651# 3706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16652!$omp end target teams loop
16653# 3706 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16654#endif
16655
16656 if (viscous) then
16657
16658# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16659
16660# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16661#if defined(MFC_OpenACC)
16662# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16663!$acc parallel loop collapse(3) gang vector default(present)
16664# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16665#elif defined(MFC_OpenMP)
16666# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16667
16668# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16669
16670# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16671
16672# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16673!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16674# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16675#endif
16676 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16677 do l = isz%beg, isz%end
16678 do k = isy%beg, isy%end
16679 dqr_prim_dx_vf(i)%sf(m + 1, k, l) = dql_prim_dx_vf(i)%sf(m, k, l)
16680 end do
16681 end do
16682 end do
16683
16684# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16685#if defined(MFC_OpenACC)
16686# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16687!$acc end parallel loop
16688# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16689#elif defined(MFC_OpenMP)
16690# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16691
16692# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16693!$omp end target teams loop
16694# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16695#endif
16696
16697 if (n > 0) then
16698
16699# 3720 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16700
16701# 3720 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16702#if defined(MFC_OpenACC)
16703# 3720 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16704!$acc parallel loop collapse(3) gang vector default(present)
16705# 3720 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16706#elif defined(MFC_OpenMP)
16707# 3720 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16708
16709# 3720 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16710
16711# 3720 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16712
16713# 3720 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16714!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16715# 3720 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16716#endif
16717 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16718 do l = isz%beg, isz%end
16719 do k = isy%beg, isy%end
16720 dqr_prim_dy_vf(i)%sf(m + 1, k, l) = dql_prim_dy_vf(i)%sf(m, k, l)
16721 end do
16722 end do
16723 end do
16724
16725# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16726#if defined(MFC_OpenACC)
16727# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16728!$acc end parallel loop
16729# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16730#elif defined(MFC_OpenMP)
16731# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16732
16733# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16734!$omp end target teams loop
16735# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16736#endif
16737
16738 if (p > 0) then
16739
16740# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16741
16742# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16743#if defined(MFC_OpenACC)
16744# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16745!$acc parallel loop collapse(3) gang vector default(present)
16746# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16747#elif defined(MFC_OpenMP)
16748# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16749
16750# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16751
16752# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16753
16754# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16755!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16756# 3731 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16757#endif
16758 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16759 do l = isz%beg, isz%end
16760 do k = isy%beg, isy%end
16761 dqr_prim_dz_vf(i)%sf(m + 1, k, l) = dql_prim_dz_vf(i)%sf(m, k, l)
16762 end do
16763 end do
16764 end do
16765
16766# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16767#if defined(MFC_OpenACC)
16768# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16769!$acc end parallel loop
16770# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16771#elif defined(MFC_OpenMP)
16772# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16773
16774# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16775!$omp end target teams loop
16776# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16777#endif
16778 end if
16779 end if
16780 end if
16781 end if
16782 ! END: Population of Buffers in x-direction
16783
16784 ! Population of Buffers in y-direction
16785 else if (norm_dir == 2) then
16786 if (bc_y%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
16787
16788# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16789
16790# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16791#if defined(MFC_OpenACC)
16792# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16793!$acc parallel loop collapse(3) gang vector default(present)
16794# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16795#elif defined(MFC_OpenMP)
16796# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16797
16798# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16799
16800# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16801
16802# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16803!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16804# 3749 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16805#endif
16806 do i = 1, sys_size
16807 do l = is3%beg, is3%end
16808 do k = is2%beg, is2%end
16809 ql_prim_rsx_vf(k, -1, l, i) = qr_prim_rsx_vf(k, 0, l, i)
16810 end do
16811 end do
16812 end do
16813
16814# 3757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16815#if defined(MFC_OpenACC)
16816# 3757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16817!$acc end parallel loop
16818# 3757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16819#elif defined(MFC_OpenMP)
16820# 3757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16821
16822# 3757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16823!$omp end target teams loop
16824# 3757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16825#endif
16826
16827 if (viscous) then
16828
16829# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16830
16831# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16832#if defined(MFC_OpenACC)
16833# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16834!$acc parallel loop collapse(3) gang vector default(present)
16835# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16836#elif defined(MFC_OpenMP)
16837# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16838
16839# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16840
16841# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16842
16843# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16844!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16845# 3760 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16846#endif
16847 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16848 do l = isz%beg, isz%end
16849 do j = isx%beg, isx%end
16850 dql_prim_dx_vf(i)%sf(j, -1, l) = dqr_prim_dx_vf(i)%sf(j, 0, l)
16851 end do
16852 end do
16853 end do
16854
16855# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16856#if defined(MFC_OpenACC)
16857# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16858!$acc end parallel loop
16859# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16860#elif defined(MFC_OpenMP)
16861# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16862
16863# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16864!$omp end target teams loop
16865# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16866#endif
16867
16868
16869# 3770 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16870
16871# 3770 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16872#if defined(MFC_OpenACC)
16873# 3770 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16874!$acc parallel loop collapse(3) gang vector default(present)
16875# 3770 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16876#elif defined(MFC_OpenMP)
16877# 3770 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16878
16879# 3770 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16880
16881# 3770 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16882
16883# 3770 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16884!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16885# 3770 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16886#endif
16887 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16888 do l = isz%beg, isz%end
16889 do j = isx%beg, isx%end
16890 dql_prim_dy_vf(i)%sf(j, -1, l) = dqr_prim_dy_vf(i)%sf(j, 0, l)
16891 end do
16892 end do
16893 end do
16894
16895# 3778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16896#if defined(MFC_OpenACC)
16897# 3778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16898!$acc end parallel loop
16899# 3778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16900#elif defined(MFC_OpenMP)
16901# 3778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16902
16903# 3778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16904!$omp end target teams loop
16905# 3778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16906#endif
16907
16908 if (p > 0) then
16909
16910# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16911
16912# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16913#if defined(MFC_OpenACC)
16914# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16915!$acc parallel loop collapse(3) gang vector default(present)
16916# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16917#elif defined(MFC_OpenMP)
16918# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16919
16920# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16921
16922# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16923
16924# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16925!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16926# 3781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16927#endif
16928 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16929 do l = isz%beg, isz%end
16930 do j = isx%beg, isx%end
16931 dql_prim_dz_vf(i)%sf(j, -1, l) = dqr_prim_dz_vf(i)%sf(j, 0, l)
16932 end do
16933 end do
16934 end do
16935
16936# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16937#if defined(MFC_OpenACC)
16938# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16939!$acc end parallel loop
16940# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16941#elif defined(MFC_OpenMP)
16942# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16943
16944# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16945!$omp end target teams loop
16946# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16947#endif
16948 end if
16949 end if
16950 end if
16951
16952 if (bc_y%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
16953
16954
16955# 3796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16956
16957# 3796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16958#if defined(MFC_OpenACC)
16959# 3796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16960!$acc parallel loop collapse(3) gang vector default(present)
16961# 3796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16962#elif defined(MFC_OpenMP)
16963# 3796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16964
16965# 3796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16966
16967# 3796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16968
16969# 3796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16970!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16971# 3796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16972#endif
16973 do i = 1, sys_size
16974 do l = is3%beg, is3%end
16975 do k = is2%beg, is2%end
16976 qr_prim_rsx_vf(k, n + 1, l, i) = ql_prim_rsx_vf(k, n, l, i)
16977 end do
16978 end do
16979 end do
16980
16981# 3804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16982#if defined(MFC_OpenACC)
16983# 3804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16984!$acc end parallel loop
16985# 3804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16986#elif defined(MFC_OpenMP)
16987# 3804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16988
16989# 3804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16990!$omp end target teams loop
16991# 3804 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16992#endif
16993
16994 if (viscous) then
16995
16996# 3807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16997
16998# 3807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16999#if defined(MFC_OpenACC)
17000# 3807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17001!$acc parallel loop collapse(3) gang vector default(present)
17002# 3807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17003#elif defined(MFC_OpenMP)
17004# 3807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17005
17006# 3807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17007
17008# 3807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17009
17010# 3807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17011!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17012# 3807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17013#endif
17014 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17015 do l = isz%beg, isz%end
17016 do j = isx%beg, isx%end
17017 dqr_prim_dx_vf(i)%sf(j, n + 1, l) = dql_prim_dx_vf(i)%sf(j, n, l)
17018 end do
17019 end do
17020 end do
17021
17022# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17023#if defined(MFC_OpenACC)
17024# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17025!$acc end parallel loop
17026# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17027#elif defined(MFC_OpenMP)
17028# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17029
17030# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17031!$omp end target teams loop
17032# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17033#endif
17034
17035
17036# 3817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17037
17038# 3817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17039#if defined(MFC_OpenACC)
17040# 3817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17041!$acc parallel loop collapse(3) gang vector default(present)
17042# 3817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17043#elif defined(MFC_OpenMP)
17044# 3817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17045
17046# 3817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17047
17048# 3817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17049
17050# 3817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17051!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17052# 3817 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17053#endif
17054 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17055 do l = isz%beg, isz%end
17056 do j = isx%beg, isx%end
17057 dqr_prim_dy_vf(i)%sf(j, n + 1, l) = dql_prim_dy_vf(i)%sf(j, n, l)
17058 end do
17059 end do
17060 end do
17061
17062# 3825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17063#if defined(MFC_OpenACC)
17064# 3825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17065!$acc end parallel loop
17066# 3825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17067#elif defined(MFC_OpenMP)
17068# 3825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17069
17070# 3825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17071!$omp end target teams loop
17072# 3825 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17073#endif
17074
17075 if (p > 0) then
17076
17077# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17078
17079# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17080#if defined(MFC_OpenACC)
17081# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17082!$acc parallel loop collapse(3) gang vector default(present)
17083# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17084#elif defined(MFC_OpenMP)
17085# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17086
17087# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17088
17089# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17090
17091# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17092!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17093# 3828 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17094#endif
17095 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17096 do l = isz%beg, isz%end
17097 do j = isx%beg, isx%end
17098 dqr_prim_dz_vf(i)%sf(j, n + 1, l) = dql_prim_dz_vf(i)%sf(j, n, l)
17099 end do
17100 end do
17101 end do
17102
17103# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17104#if defined(MFC_OpenACC)
17105# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17106!$acc end parallel loop
17107# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17108#elif defined(MFC_OpenMP)
17109# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17110
17111# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17112!$omp end target teams loop
17113# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17114#endif
17115 end if
17116 end if
17117 end if
17118 ! END: Population of Buffers in y-direction
17119
17120 ! Population of Buffers in z-direction
17121 else
17122 if (bc_z%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
17123
17124# 3845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17125
17126# 3845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17127#if defined(MFC_OpenACC)
17128# 3845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17129!$acc parallel loop collapse(3) gang vector default(present)
17130# 3845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17131#elif defined(MFC_OpenMP)
17132# 3845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17133
17134# 3845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17135
17136# 3845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17137
17138# 3845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17139!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17140# 3845 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17141#endif
17142 do i = 1, sys_size
17143 do k = is2%beg, is2%end
17144 do l = is3%beg, is3%end
17145 ql_prim_rsx_vf(l, k, -1, i) = qr_prim_rsx_vf(l, k, 0, i)
17146 end do
17147 end do
17148 end do
17149
17150# 3853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17151#if defined(MFC_OpenACC)
17152# 3853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17153!$acc end parallel loop
17154# 3853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17155#elif defined(MFC_OpenMP)
17156# 3853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17157
17158# 3853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17159!$omp end target teams loop
17160# 3853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17161#endif
17162
17163 if (viscous) then
17164
17165# 3856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17166
17167# 3856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17168#if defined(MFC_OpenACC)
17169# 3856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17170!$acc parallel loop collapse(3) gang vector default(present)
17171# 3856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17172#elif defined(MFC_OpenMP)
17173# 3856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17174
17175# 3856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17176
17177# 3856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17178
17179# 3856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17180!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17181# 3856 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17182#endif
17183 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17184 do k = isy%beg, isy%end
17185 do j = isx%beg, isx%end
17186 dql_prim_dx_vf(i)%sf(j, k, -1) = dqr_prim_dx_vf(i)%sf(j, k, 0)
17187 end do
17188 end do
17189 end do
17190
17191# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17192#if defined(MFC_OpenACC)
17193# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17194!$acc end parallel loop
17195# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17196#elif defined(MFC_OpenMP)
17197# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17198
17199# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17200!$omp end target teams loop
17201# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17202#endif
17203
17204# 3865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17205
17206# 3865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17207#if defined(MFC_OpenACC)
17208# 3865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17209!$acc parallel loop collapse(3) gang vector default(present)
17210# 3865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17211#elif defined(MFC_OpenMP)
17212# 3865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17213
17214# 3865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17215
17216# 3865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17217
17218# 3865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17219!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17220# 3865 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17221#endif
17222 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17223 do k = isy%beg, isy%end
17224 do j = isx%beg, isx%end
17225 dql_prim_dy_vf(i)%sf(j, k, -1) = dqr_prim_dy_vf(i)%sf(j, k, 0)
17226 end do
17227 end do
17228 end do
17229
17230# 3873 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17231#if defined(MFC_OpenACC)
17232# 3873 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17233!$acc end parallel loop
17234# 3873 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17235#elif defined(MFC_OpenMP)
17236# 3873 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17237
17238# 3873 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17239!$omp end target teams loop
17240# 3873 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17241#endif
17242
17243# 3874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17244
17245# 3874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17246#if defined(MFC_OpenACC)
17247# 3874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17248!$acc parallel loop collapse(3) gang vector default(present)
17249# 3874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17250#elif defined(MFC_OpenMP)
17251# 3874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17252
17253# 3874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17254
17255# 3874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17256
17257# 3874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17258!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17259# 3874 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17260#endif
17261 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17262 do k = isy%beg, isy%end
17263 do j = isx%beg, isx%end
17264 dql_prim_dz_vf(i)%sf(j, k, -1) = dqr_prim_dz_vf(i)%sf(j, k, 0)
17265 end do
17266 end do
17267 end do
17268
17269# 3882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17270#if defined(MFC_OpenACC)
17271# 3882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17272!$acc end parallel loop
17273# 3882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17274#elif defined(MFC_OpenMP)
17275# 3882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17276
17277# 3882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17278!$omp end target teams loop
17279# 3882 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17280#endif
17281 end if
17282 end if
17283
17284 if (bc_z%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
17285
17286
17287# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17288
17289# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17290#if defined(MFC_OpenACC)
17291# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17292!$acc parallel loop collapse(3) gang vector default(present)
17293# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17294#elif defined(MFC_OpenMP)
17295# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17296
17297# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17298
17299# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17300
17301# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17302!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17303# 3888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17304#endif
17305 do i = 1, sys_size
17306 do k = is2%beg, is2%end
17307 do l = is3%beg, is3%end
17308 qr_prim_rsx_vf(l, k, p + 1, i) = ql_prim_rsx_vf(l, k, p, i)
17309 end do
17310 end do
17311 end do
17312
17313# 3896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17314#if defined(MFC_OpenACC)
17315# 3896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17316!$acc end parallel loop
17317# 3896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17318#elif defined(MFC_OpenMP)
17319# 3896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17320
17321# 3896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17322!$omp end target teams loop
17323# 3896 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17324#endif
17325
17326 if (viscous) then
17327
17328# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17329
17330# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17331#if defined(MFC_OpenACC)
17332# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17333!$acc parallel loop collapse(3) gang vector default(present)
17334# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17335#elif defined(MFC_OpenMP)
17336# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17337
17338# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17339
17340# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17341
17342# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17343!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17344# 3899 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17345#endif
17346 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17347 do k = isy%beg, isy%end
17348 do j = isx%beg, isx%end
17349 dqr_prim_dx_vf(i)%sf(j, k, p + 1) = dql_prim_dx_vf(i)%sf(j, k, p)
17350 end do
17351 end do
17352 end do
17353
17354# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17355#if defined(MFC_OpenACC)
17356# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17357!$acc end parallel loop
17358# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17359#elif defined(MFC_OpenMP)
17360# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17361
17362# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17363!$omp end target teams loop
17364# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17365#endif
17366
17367
17368# 3909 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17369
17370# 3909 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17371#if defined(MFC_OpenACC)
17372# 3909 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17373!$acc parallel loop collapse(3) gang vector default(present)
17374# 3909 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17375#elif defined(MFC_OpenMP)
17376# 3909 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17377
17378# 3909 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17379
17380# 3909 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17381
17382# 3909 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17383!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17384# 3909 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17385#endif
17386 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17387 do k = isy%beg, isy%end
17388 do j = isx%beg, isx%end
17389 dqr_prim_dy_vf(i)%sf(j, k, p + 1) = dql_prim_dy_vf(i)%sf(j, k, p)
17390 end do
17391 end do
17392 end do
17393
17394# 3917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17395#if defined(MFC_OpenACC)
17396# 3917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17397!$acc end parallel loop
17398# 3917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17399#elif defined(MFC_OpenMP)
17400# 3917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17401
17402# 3917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17403!$omp end target teams loop
17404# 3917 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17405#endif
17406
17407
17408# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17409
17410# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17411#if defined(MFC_OpenACC)
17412# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17413!$acc parallel loop collapse(3) gang vector default(present)
17414# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17415#elif defined(MFC_OpenMP)
17416# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17417
17418# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17419
17420# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17421
17422# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17423!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17424# 3919 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17425#endif
17426 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17427 do k = isy%beg, isy%end
17428 do j = isx%beg, isx%end
17429 dqr_prim_dz_vf(i)%sf(j, k, p + 1) = dql_prim_dz_vf(i)%sf(j, k, p)
17430 end do
17431 end do
17432 end do
17433
17434# 3927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17435#if defined(MFC_OpenACC)
17436# 3927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17437!$acc end parallel loop
17438# 3927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17439#elif defined(MFC_OpenMP)
17440# 3927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17441
17442# 3927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17443!$omp end target teams loop
17444# 3927 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17445#endif
17446 end if
17447 end if
17448 end if
17449 ! END: Population of Buffers in z-direction
17450
17451 end subroutine s_populate_riemann_states_variables_buffers
17452
17453 !> Set up the chosen Riemann solver algorithm for the current direction
17454 subroutine s_initialize_riemann_solver(flux_src_vf, norm_dir)
17455
17456 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
17457 integer, intent(in) :: norm_dir
17458 integer :: i, j, k, l !< Generic loop iterators
17459
17460 ! Reshaping Inputted Data in x-direction
17461
17462 if (norm_dir == 1) then
17463 if (viscous .or. (surface_tension)) then
17464
17465# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17466
17467# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17468#if defined(MFC_OpenACC)
17469# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17470!$acc parallel loop collapse(4) gang vector default(present)
17471# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17472#elif defined(MFC_OpenMP)
17473# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17474
17475# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17476
17477# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17478
17479# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17480!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17481# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17482#endif
17483 do i = eqn_idx%mom%beg, eqn_idx%E
17484 do l = is3%beg, is3%end
17485 do k = is2%beg, is2%end
17486 do j = is1%beg, is1%end
17487 flux_src_vf(i)%sf(j, k, l) = 0._wp
17488 end do
17489 end do
17490 end do
17491 end do
17492
17493# 3956 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17494#if defined(MFC_OpenACC)
17495# 3956 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17496!$acc end parallel loop
17497# 3956 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17498#elif defined(MFC_OpenMP)
17499# 3956 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17500
17501# 3956 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17502!$omp end target teams loop
17503# 3956 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17504#endif
17505 end if
17506
17507 if (chem_params%diffusion) then
17508
17509# 3960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17510
17511# 3960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17512#if defined(MFC_OpenACC)
17513# 3960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17514!$acc parallel loop collapse(4) gang vector default(present)
17515# 3960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17516#elif defined(MFC_OpenMP)
17517# 3960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17518
17519# 3960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17520
17521# 3960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17522
17523# 3960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17524!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17525# 3960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17526#endif
17527 do i = eqn_idx%E, eqn_idx%species%end
17528 do l = is3%beg, is3%end
17529 do k = is2%beg, is2%end
17530 do j = is1%beg, is1%end
17531 if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then
17532 flux_src_vf(i)%sf(j, k, l) = 0._wp
17533 end if
17534 end do
17535 end do
17536 end do
17537 end do
17538
17539# 3972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17540#if defined(MFC_OpenACC)
17541# 3972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17542!$acc end parallel loop
17543# 3972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17544#elif defined(MFC_OpenMP)
17545# 3972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17546
17547# 3972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17548!$omp end target teams loop
17549# 3972 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17550#endif
17551 end if
17552
17553 if (qbmm) then
17554
17555# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17556
17557# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17558#if defined(MFC_OpenACC)
17559# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17560!$acc parallel loop collapse(4) gang vector default(present)
17561# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17562#elif defined(MFC_OpenMP)
17563# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17564
17565# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17566
17567# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17568
17569# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17570!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17571# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17572#endif
17573 do i = 1, 4
17574 do l = is3%beg, is3%end
17575 do k = is2%beg, is2%end
17576 do j = is1%beg, is1%end + 1
17577 mom_sp_rsx_vf(j, k, l, i) = mom_sp(i)%sf(j, k, l)
17578 end do
17579 end do
17580 end do
17581 end do
17582
17583# 3986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17584#if defined(MFC_OpenACC)
17585# 3986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17586!$acc end parallel loop
17587# 3986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17588#elif defined(MFC_OpenMP)
17589# 3986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17590
17591# 3986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17592!$omp end target teams loop
17593# 3986 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17594#endif
17595 end if
17596
17597 ! Reshaping Inputted Data in y-direction
17598 else if (norm_dir == 2) then
17599 if (viscous .or. (surface_tension)) then
17600
17601# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17602
17603# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17604#if defined(MFC_OpenACC)
17605# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17606!$acc parallel loop collapse(4) gang vector default(present)
17607# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17608#elif defined(MFC_OpenMP)
17609# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17610
17611# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17612
17613# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17614
17615# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17616!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17617# 3992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17618#endif
17619 do i = eqn_idx%mom%beg, eqn_idx%E
17620 do l = is3%beg, is3%end
17621 do j = is1%beg, is1%end
17622 do k = is2%beg, is2%end
17623 flux_src_vf(i)%sf(k, j, l) = 0._wp
17624 end do
17625 end do
17626 end do
17627 end do
17628
17629# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17630#if defined(MFC_OpenACC)
17631# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17632!$acc end parallel loop
17633# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17634#elif defined(MFC_OpenMP)
17635# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17636
17637# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17638!$omp end target teams loop
17639# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17640#endif
17641 end if
17642
17643 if (chem_params%diffusion) then
17644
17645# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17646
17647# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17648#if defined(MFC_OpenACC)
17649# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17650!$acc parallel loop collapse(4) gang vector default(present)
17651# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17652#elif defined(MFC_OpenMP)
17653# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17654
17655# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17656
17657# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17658
17659# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17660!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17661# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17662#endif
17663 do i = eqn_idx%E, eqn_idx%species%end
17664 do l = is3%beg, is3%end
17665 do j = is1%beg, is1%end
17666 do k = is2%beg, is2%end
17667 if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then
17668 flux_src_vf(i)%sf(k, j, l) = 0._wp
17669 end if
17670 end do
17671 end do
17672 end do
17673 end do
17674
17675# 4018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17676#if defined(MFC_OpenACC)
17677# 4018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17678!$acc end parallel loop
17679# 4018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17680#elif defined(MFC_OpenMP)
17681# 4018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17682
17683# 4018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17684!$omp end target teams loop
17685# 4018 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17686#endif
17687 end if
17688
17689 if (qbmm) then
17690
17691# 4022 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17692
17693# 4022 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17694#if defined(MFC_OpenACC)
17695# 4022 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17696!$acc parallel loop collapse(4) gang vector default(present)
17697# 4022 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17698#elif defined(MFC_OpenMP)
17699# 4022 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17700
17701# 4022 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17702
17703# 4022 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17704
17705# 4022 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17706!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17707# 4022 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17708#endif
17709 do i = 1, 4
17710 do l = is3%beg, is3%end
17711 do k = is2%beg, is2%end
17712 do j = is1%beg, is1%end + 1
17713 mom_sp_rsx_vf(k, j, l, i) = mom_sp(i)%sf(k, j, l)
17714 end do
17715 end do
17716 end do
17717 end do
17718
17719# 4032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17720#if defined(MFC_OpenACC)
17721# 4032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17722!$acc end parallel loop
17723# 4032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17724#elif defined(MFC_OpenMP)
17725# 4032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17726
17727# 4032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17728!$omp end target teams loop
17729# 4032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17730#endif
17731 end if
17732
17733 ! Reshaping Inputted Data in z-direction
17734 else
17735 if (viscous .or. (surface_tension)) then
17736
17737# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17738
17739# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17740#if defined(MFC_OpenACC)
17741# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17742!$acc parallel loop collapse(4) gang vector default(present)
17743# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17744#elif defined(MFC_OpenMP)
17745# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17746
17747# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17748
17749# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17750
17751# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17752!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17753# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17754#endif
17755 do i = eqn_idx%mom%beg, eqn_idx%E
17756 do j = is1%beg, is1%end
17757 do k = is2%beg, is2%end
17758 do l = is3%beg, is3%end
17759 flux_src_vf(i)%sf(l, k, j) = 0._wp
17760 end do
17761 end do
17762 end do
17763 end do
17764
17765# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17766#if defined(MFC_OpenACC)
17767# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17768!$acc end parallel loop
17769# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17770#elif defined(MFC_OpenMP)
17771# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17772
17773# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17774!$omp end target teams loop
17775# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17776#endif
17777 end if
17778
17779 if (chem_params%diffusion) then
17780
17781# 4052 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17782
17783# 4052 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17784#if defined(MFC_OpenACC)
17785# 4052 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17786!$acc parallel loop collapse(4) gang vector default(present)
17787# 4052 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17788#elif defined(MFC_OpenMP)
17789# 4052 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17790
17791# 4052 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17792
17793# 4052 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17794
17795# 4052 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17796!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17797# 4052 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17798#endif
17799 do i = eqn_idx%E, eqn_idx%species%end
17800 do j = is1%beg, is1%end
17801 do k = is2%beg, is2%end
17802 do l = is3%beg, is3%end
17803 if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then
17804 flux_src_vf(i)%sf(l, k, j) = 0._wp
17805 end if
17806 end do
17807 end do
17808 end do
17809 end do
17810
17811# 4064 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17812#if defined(MFC_OpenACC)
17813# 4064 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17814!$acc end parallel loop
17815# 4064 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17816#elif defined(MFC_OpenMP)
17817# 4064 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17818
17819# 4064 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17820!$omp end target teams loop
17821# 4064 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17822#endif
17823 end if
17824
17825 if (qbmm) then
17826
17827# 4068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17828
17829# 4068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17830#if defined(MFC_OpenACC)
17831# 4068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17832!$acc parallel loop collapse(4) gang vector default(present)
17833# 4068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17834#elif defined(MFC_OpenMP)
17835# 4068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17836
17837# 4068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17838
17839# 4068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17840
17841# 4068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17842!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17843# 4068 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17844#endif
17845 do i = 1, 4
17846 do l = is3%beg, is3%end
17847 do k = is2%beg, is2%end
17848 do j = is1%beg, is1%end + 1
17849 mom_sp_rsx_vf(l, k, j, i) = mom_sp(i)%sf(l, k, j)
17850 end do
17851 end do
17852 end do
17853 end do
17854
17855# 4078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17856#if defined(MFC_OpenACC)
17857# 4078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17858!$acc end parallel loop
17859# 4078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17860#elif defined(MFC_OpenMP)
17861# 4078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17862
17863# 4078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17864!$omp end target teams loop
17865# 4078 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17866#endif
17867 end if
17868 end if
17869
17870 end subroutine s_initialize_riemann_solver
17871
17872 !> Compute cylindrical viscous source flux contributions for momentum and energy
17873 subroutine s_compute_cylindrical_viscous_source_flux(velL_vf, dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, velR_vf, dvelR_dx_vf, &
17874
17875 & dvelR_dy_vf, dvelR_dz_vf, flux_src_vf, norm_dir, ix, iy, iz)
17876
17877 type(scalar_field), dimension(num_dims), intent(in) :: velL_vf, velR_vf
17878 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
17879 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
17880 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
17881 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
17882 integer, intent(in) :: norm_dir
17883 type(int_bounds_info), intent(in) :: ix, iy, iz
17884
17885 ! Local variables
17886
17887# 4109 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17888 real(wp), dimension(num_dims) :: avg_v_int !< Averaged interface velocity (\f$v_x, v_y, v_z\f$) (grid directions).
17889 real(wp), dimension(num_dims) :: avg_dvdx_int !< Averaged interface \f$\partial v_i/\partial x\f$ (grid dir 1).
17890 real(wp), dimension(num_dims) :: avg_dvdy_int !< Averaged interface \f$\partial v_i/\partial y\f$ (grid dir 2).
17891 real(wp), dimension(num_dims) :: avg_dvdz_int !< Averaged interface \f$\partial v_i/\partial z\f$ (grid dir 3).
17892 !> Interface velocity (\f$v_1,v_2,v_3\f$) (grid directions) for viscous work.
17893 real(wp), dimension(num_dims) :: vel_src_int
17894 !> Shear stress vector (\f$\sigma_{N1}, \sigma_{N2}, \sigma_{N3}\f$) on N-face (grid directions).
17895 real(wp), dimension(num_dims) :: stress_vector_shear
17896# 4118 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17897 real(wp) :: stress_normal_bulk !< Normal bulk stress component \f$\sigma_{NN}\f$ on N-face.
17898 real(wp) :: Re_s, Re_b !< Effective interface shear and bulk Reynolds numbers.
17899 real(wp) :: r_eff !< Effective radius at interface for cylindrical terms.
17900 real(wp) :: div_v_term_const !< Common term \f$-(2/3)(\nabla \cdot \mathbf{v}) / \text{Re}_s\f$ for shear stress diagonal.
17901 real(wp) :: divergence_cyl !< Full divergence \f$\nabla \cdot \mathbf{v}\f$ in cylindrical coordinates.
17902 integer :: j, k, l !< Loop iterators for \f$x, y, z\f$ grid directions.
17903 integer :: i_vel !< Loop iterator for velocity components.
17904 integer :: idx_rp(3) !< Indices \f$(j,k,l)\f$ of 'right' point for averaging.
17905
17906
17907# 4127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17908
17909# 4127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17910#if defined(MFC_OpenACC)
17911# 4127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17912!$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)
17913# 4127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17914#elif defined(MFC_OpenMP)
17915# 4127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17916
17917# 4127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17918
17919# 4127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17920
17921# 4127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17922!$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)
17923# 4127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17924#endif
17925# 4129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17926 do l = iz%beg, iz%end
17927 do k = iy%beg, iy%end
17928 do j = ix%beg, ix%end
17929 ! Determine indices for the 'right' state for averaging across the interface
17930 idx_rp = [j, k, l]
17931 idx_rp(norm_dir) = idx_rp(norm_dir) + 1
17932
17933 ! Average velocities and their derivatives at the interface For cylindrical: x-dir ~ axial (z_cyl), y-dir ~
17934 ! radial (r_cyl), z-dir ~ azimuthal (theta_cyl)
17935
17936# 4138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17937#if defined(MFC_OpenACC)
17938# 4138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17939!$acc loop seq
17940# 4138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17941#elif defined(MFC_OpenMP)
17942# 4138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17943
17944# 4138 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17945#endif
17946 do i_vel = 1, num_dims
17947 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)))
17948
17949 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), &
17950 & idx_rp(2), idx_rp(3)))
17951 if (num_dims > 1) then
17952 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), &
17953 & idx_rp(2), idx_rp(3)))
17954 else
17955 avg_dvdy_int(i_vel) = 0.0_wp
17956 end if
17957 if (num_dims > 2) then
17958 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), &
17959 & idx_rp(2), idx_rp(3)))
17960 else
17961 avg_dvdz_int(i_vel) = 0.0_wp
17962 end if
17963 end do
17964
17965 ! Get Re numbers and interface velocity for viscous work
17966 select case (norm_dir)
17967 case (1) ! x-face (axial face in z_cyl direction)
17968 re_s = re_avg_rsx_vf(j, k, l, 1)
17969 re_b = re_avg_rsx_vf(j, k, l, 2)
17970 vel_src_int = vel_src_rsx_vf(j, k, l,1:num_dims)
17971 r_eff = y_cc(k)
17972 case (2) ! y-face (radial face in r_cyl direction)
17973 re_s = re_avg_rsx_vf(j, k, l, 1)
17974 re_b = re_avg_rsx_vf(j, k, l, 2)
17975 vel_src_int = vel_src_rsx_vf(j, k, l,1:num_dims)
17976 r_eff = y_cb(k)
17977 case (3) ! z-face (azimuthal face in theta_cyl direction)
17978 re_s = re_avg_rsx_vf(j, k, l, 1)
17979 re_b = re_avg_rsx_vf(j, k, l, 2)
17980 vel_src_int = vel_src_rsx_vf(j, k, l,1:num_dims)
17981 r_eff = y_cc(k)
17982 end select
17983
17984 ! Divergence in cylindrical coordinates (vx=vz_cyl, vy=vr_cyl, vz=vtheta_cyl)
17985# 4179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17986 divergence_cyl = avg_dvdx_int(1) + avg_dvdy_int(2) + avg_v_int(2)/r_eff
17987 if (num_dims > 2) then
17988# 4182 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17989 divergence_cyl = divergence_cyl + avg_dvdz_int(3)/r_eff
17990# 4184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17991 end if
17992# 4186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17993
17994 stress_vector_shear = 0.0_wp
17995 stress_normal_bulk = 0.0_wp
17996
17997 if (shear_stress) then
17998 div_v_term_const = -(2.0_wp/3.0_wp)*divergence_cyl/re_s
17999
18000 select case (norm_dir)
18001 case (1) ! X-face (axial normal, z_cyl)
18002 stress_vector_shear(1) = (2.0_wp*avg_dvdx_int(1))/re_s + div_v_term_const
18003 if (num_dims > 1) then
18004# 4198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18005 stress_vector_shear(2) = (avg_dvdy_int(1) + avg_dvdx_int(2))/re_s
18006# 4200 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18007 end if
18008 if (num_dims > 2) then
18009# 4203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18010 stress_vector_shear(3) = (avg_dvdz_int(1)/r_eff + avg_dvdx_int(3))/re_s
18011# 4205 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18012 end if
18013 case (2) ! Y-face (radial normal, r_cyl)
18014 if (num_dims > 1) then
18015# 4209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18016 stress_vector_shear(1) = (avg_dvdy_int(1) + avg_dvdx_int(2))/re_s
18017 stress_vector_shear(2) = (2.0_wp*avg_dvdy_int(2))/re_s + div_v_term_const
18018 if (num_dims > 2) then
18019# 4213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18020 stress_vector_shear(3) = (avg_dvdz_int(2)/r_eff - avg_v_int(3)/r_eff + avg_dvdy_int(3) &
18021 & )/re_s
18022# 4216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18023 end if
18024# 4218 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18025 else
18026 stress_vector_shear(1) = (2.0_wp*avg_dvdx_int(1))/re_s + div_v_term_const
18027 end if
18028 case (3) ! Z-face (azimuthal normal, theta_cyl)
18029 if (num_dims > 2) then
18030# 4224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18031 stress_vector_shear(1) = (avg_dvdz_int(1)/r_eff + avg_dvdx_int(3))/re_s
18032 stress_vector_shear(2) = (avg_dvdz_int(2)/r_eff - avg_v_int(3)/r_eff + avg_dvdy_int(3))/re_s
18033 stress_vector_shear(3) = (2.0_wp*(avg_dvdz_int(3)/r_eff + avg_v_int(2)/r_eff))/re_s &
18034 & + div_v_term_const
18035# 4229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18036 end if
18037 end select
18038
18039
18040# 4232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18041#if defined(MFC_OpenACC)
18042# 4232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18043!$acc loop seq
18044# 4232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18045#elif defined(MFC_OpenMP)
18046# 4232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18047
18048# 4232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18049#endif
18050 do i_vel = 1, num_dims
18051 flux_src_vf(eqn_idx%mom%beg + i_vel - 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + i_vel - 1)%sf(j, &
18052 & k, l) - stress_vector_shear(i_vel)
18053 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
18054 & l) - vel_src_int(i_vel)*stress_vector_shear(i_vel)
18055 end do
18056 end if
18057
18058 if (bulk_stress) then
18059 stress_normal_bulk = divergence_cyl/re_b
18060
18061 flux_src_vf(eqn_idx%mom%beg + norm_dir - 1)%sf(j, k, &
18062 & l) = flux_src_vf(eqn_idx%mom%beg + norm_dir - 1)%sf(j, k, l) - stress_normal_bulk
18063 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
18064 & l) - vel_src_int(norm_dir)*stress_normal_bulk
18065 end if
18066 end do
18067 end do
18068 end do
18069
18070# 4252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18071#if defined(MFC_OpenACC)
18072# 4252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18073!$acc end parallel loop
18074# 4252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18075#elif defined(MFC_OpenMP)
18076# 4252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18077
18078# 4252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18079!$omp end target teams loop
18080# 4252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18081#endif
18082
18083 end subroutine s_compute_cylindrical_viscous_source_flux
18084
18085 !> Compute Cartesian viscous source flux contributions for momentum and energy
18086 subroutine s_compute_cartesian_viscous_source_flux(dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, dvelR_dx_vf, dvelR_dy_vf, &
18087
18088 & dvelR_dz_vf, flux_src_vf, norm_dir)
18089
18090 ! Arguments
18091 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
18092 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
18093 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
18094 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
18095 integer, intent(in) :: norm_dir
18096
18097 ! Local variables
18098
18099# 4276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18100 real(wp), dimension(num_dims, num_dims) :: vel_grad_avg !< Averaged velocity gradient tensor `d(vel_i)/d(coord_j)`.
18101 real(wp), dimension(num_dims, num_dims) :: current_tau_shear !< Current shear stress tensor.
18102 real(wp), dimension(num_dims, num_dims) :: current_tau_bulk !< Current bulk stress tensor.
18103 real(wp), dimension(num_dims) :: vel_src_at_interface !< Interface velocities (u,v,w) for viscous work.
18104# 4281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18105 integer, dimension(3) :: idx_right_phys !< Physical (j,k,l) indices for right state.
18106 real(wp) :: Re_shear !< Interface shear Reynolds number.
18107 real(wp) :: Re_bulk !< Interface bulk Reynolds number.
18108 integer :: j_loop !< Physical x-index loop iterator.
18109 integer :: k_loop !< Physical y-index loop iterator.
18110 integer :: l_loop !< Physical z-index loop iterator.
18111 integer :: i_dim !< Generic dimension/component iterator.
18112 integer :: vel_comp_idx !< Velocity component iterator (1=u, 2=v, 3=w).
18113 real(wp) :: divergence_v !< Velocity divergence at interface.
18114
18115
18116# 4291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18117
18118# 4291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18119#if defined(MFC_OpenACC)
18120# 4291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18121!$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)
18122# 4291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18123#elif defined(MFC_OpenMP)
18124# 4291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18125
18126# 4291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18127
18128# 4291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18129
18130# 4291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18131!$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)
18132# 4291 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18133#endif
18134# 4293 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18135 do l_loop = isz%beg, isz%end
18136 do k_loop = isy%beg, isy%end
18137 do j_loop = isx%beg, isx%end
18138 idx_right_phys(1) = j_loop
18139 idx_right_phys(2) = k_loop
18140 idx_right_phys(3) = l_loop
18141 idx_right_phys(norm_dir) = idx_right_phys(norm_dir) + 1
18142
18143 vel_grad_avg = 0.0_wp
18144 do vel_comp_idx = 1, num_dims
18145 vel_grad_avg(vel_comp_idx, 1) = 0.5_wp*(dvell_dx_vf(vel_comp_idx)%sf(j_loop, k_loop, &
18146 & l_loop) + dvelr_dx_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), &
18147 & idx_right_phys(3)))
18148 if (num_dims > 1) then
18149# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18150 vel_grad_avg(vel_comp_idx, 2) = 0.5_wp*(dvell_dy_vf(vel_comp_idx)%sf(j_loop, k_loop, &
18151 & l_loop) + dvelr_dy_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), &
18152 & idx_right_phys(3)))
18153# 4312 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18154 end if
18155 if (num_dims > 2) then
18156# 4315 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18157 vel_grad_avg(vel_comp_idx, 3) = 0.5_wp*(dvell_dz_vf(vel_comp_idx)%sf(j_loop, k_loop, &
18158 & l_loop) + dvelr_dz_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), &
18159 & idx_right_phys(3)))
18160# 4319 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18161 end if
18162 end do
18163
18164 divergence_v = 0.0_wp
18165 do i_dim = 1, num_dims
18166 divergence_v = divergence_v + vel_grad_avg(i_dim, i_dim)
18167 end do
18168
18169 vel_src_at_interface = 0.0_wp
18170 if (norm_dir == 1) then
18171 re_shear = re_avg_rsx_vf(j_loop, k_loop, l_loop, 1)
18172 re_bulk = re_avg_rsx_vf(j_loop, k_loop, l_loop, 2)
18173 do i_dim = 1, num_dims
18174 vel_src_at_interface(i_dim) = vel_src_rsx_vf(j_loop, k_loop, l_loop, i_dim)
18175 end do
18176 else if (norm_dir == 2) then
18177 re_shear = re_avg_rsx_vf(j_loop, k_loop, l_loop, 1)
18178 re_bulk = re_avg_rsx_vf(j_loop, k_loop, l_loop, 2)
18179 do i_dim = 1, num_dims
18180 vel_src_at_interface(i_dim) = vel_src_rsx_vf(j_loop, k_loop, l_loop, i_dim)
18181 end do
18182 else
18183 re_shear = re_avg_rsx_vf(j_loop, k_loop, l_loop, 1)
18184 re_bulk = re_avg_rsx_vf(j_loop, k_loop, l_loop, 2)
18185 do i_dim = 1, num_dims
18186 vel_src_at_interface(i_dim) = vel_src_rsx_vf(j_loop, k_loop, l_loop, i_dim)
18187 end do
18188 end if
18189
18190 if (shear_stress) then
18191 ! current_tau_shear = 0.0_wp
18192 call s_calculate_shear_stress_tensor(vel_grad_avg, re_shear, divergence_v, current_tau_shear)
18193
18194 do i_dim = 1, num_dims
18195 flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
18196 & l_loop) = flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
18197 & l_loop) - current_tau_shear(norm_dir, i_dim)
18198
18199 flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, &
18200 & l_loop) - vel_src_at_interface(i_dim)*current_tau_shear(norm_dir, i_dim)
18201 end do
18202 end if
18203
18204 if (bulk_stress) then
18205 ! current_tau_bulk = 0.0_wp
18206 call s_calculate_bulk_stress_tensor(re_bulk, divergence_v, current_tau_bulk)
18207
18208 do i_dim = 1, num_dims
18209 flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
18210 & l_loop) = flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
18211 & l_loop) - current_tau_bulk(norm_dir, i_dim)
18212
18213 flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, &
18214 & l_loop) - vel_src_at_interface(i_dim)*current_tau_bulk(norm_dir, i_dim)
18215 end do
18216 end if
18217 end do
18218 end do
18219 end do
18220
18221# 4378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18222#if defined(MFC_OpenACC)
18223# 4378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18224!$acc end parallel loop
18225# 4378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18226#elif defined(MFC_OpenMP)
18227# 4378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18228
18229# 4378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18230!$omp end target teams loop
18231# 4378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18232#endif
18233
18234 end subroutine s_compute_cartesian_viscous_source_flux
18235
18236 !> Compute shear stress tensor components
18237 subroutine s_calculate_shear_stress_tensor(vel_grad_avg, Re_shear, divergence_v, tau_shear_out)
18238
18239
18240# 4385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18241#if MFC_OpenACC
18242# 4385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18243!$acc routine seq
18244# 4385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18245#elif MFC_OpenMP
18246# 4385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18247
18248# 4385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18249
18250# 4385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18251!$omp declare target device_type(any)
18252# 4385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18253#endif
18254
18255 ! Arguments
18256# 4392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18257 real(wp), dimension(num_dims, num_dims), intent(in) :: vel_grad_avg
18258 real(wp), dimension(num_dims, num_dims), intent(out) :: tau_shear_out
18259# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18260 real(wp), intent(in) :: Re_shear
18261 real(wp), intent(in) :: divergence_v
18262
18263 ! Local variables
18264 integer :: i_dim !< Loop iterator for face normal.
18265 integer :: j_dim !< Loop iterator for force component direction.
18266 tau_shear_out = 0.0_wp
18267
18268 do i_dim = 1, num_dims
18269 do j_dim = 1, num_dims
18270 tau_shear_out(i_dim, j_dim) = (vel_grad_avg(j_dim, i_dim) + vel_grad_avg(i_dim, j_dim))/re_shear
18271 if (i_dim == j_dim) then
18272 tau_shear_out(i_dim, j_dim) = tau_shear_out(i_dim, j_dim) - (2.0_wp/3.0_wp)*divergence_v/re_shear
18273 end if
18274 end do
18275 end do
18276
18277 end subroutine s_calculate_shear_stress_tensor
18278
18279 !> Compute bulk stress tensor components (diagonal only)
18280 subroutine s_calculate_bulk_stress_tensor(Re_bulk, divergence_v, tau_bulk_out)
18281
18282
18283# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18284#if MFC_OpenACC
18285# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18286!$acc routine seq
18287# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18288#elif MFC_OpenMP
18289# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18290
18291# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18292
18293# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18294!$omp declare target device_type(any)
18295# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18296#endif
18297
18298 ! Arguments
18299 real(wp), intent(in) :: Re_bulk
18300 real(wp), intent(in) :: divergence_v
18301# 4425 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18302 real(wp), dimension(num_dims, num_dims), intent(out) :: tau_bulk_out
18303# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18304
18305 ! Local variables
18306 integer :: i_dim !< Loop iterator for diagonal components.
18307 tau_bulk_out = 0.0_wp
18308
18309 do i_dim = 1, num_dims
18310 tau_bulk_out(i_dim, i_dim) = divergence_v/re_bulk
18311 end do
18312
18313 end subroutine s_calculate_bulk_stress_tensor
18314
18315 !> Deallocation and/or disassociation procedures that are needed to finalize the selected Riemann problem solver
18316 subroutine s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
18317
18318 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
18319 integer, intent(in) :: norm_dir
18320 integer :: i, j, k, l !< Generic loop iterators
18321 ! Reshaping Outputted Data in y-direction
18322
18323 if (norm_dir == 2) then
18324
18325# 4447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18326
18327# 4447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18328#if defined(MFC_OpenACC)
18329# 4447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18330!$acc parallel loop collapse(4) gang vector default(present)
18331# 4447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18332#elif defined(MFC_OpenMP)
18333# 4447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18334
18335# 4447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18336
18337# 4447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18338
18339# 4447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18340!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18341# 4447 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18342#endif
18343 do i = 1, sys_size
18344 do l = is3%beg, is3%end
18345 do j = is1%beg, is1%end
18346 do k = is2%beg, is2%end
18347 flux_vf(i)%sf(k, j, l) = flux_rsx_vf(k, j, l, i)
18348 end do
18349 end do
18350 end do
18351 end do
18352
18353# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18354#if defined(MFC_OpenACC)
18355# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18356!$acc end parallel loop
18357# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18358#elif defined(MFC_OpenMP)
18359# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18360
18361# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18362!$omp end target teams loop
18363# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18364#endif
18365
18366 if (cyl_coord) then
18367
18368# 4460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18369
18370# 4460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18371#if defined(MFC_OpenACC)
18372# 4460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18373!$acc parallel loop collapse(4) gang vector default(present)
18374# 4460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18375#elif defined(MFC_OpenMP)
18376# 4460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18377
18378# 4460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18379
18380# 4460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18381
18382# 4460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18383!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18384# 4460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18385#endif
18386 do i = 1, sys_size
18387 do l = is3%beg, is3%end
18388 do j = is1%beg, is1%end
18389 do k = is2%beg, is2%end
18390 flux_gsrc_vf(i)%sf(k, j, l) = flux_gsrc_rsx_vf(k, j, l, i)
18391 end do
18392 end do
18393 end do
18394 end do
18395
18396# 4470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18397#if defined(MFC_OpenACC)
18398# 4470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18399!$acc end parallel loop
18400# 4470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18401#elif defined(MFC_OpenMP)
18402# 4470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18403
18404# 4470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18405!$omp end target teams loop
18406# 4470 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18407#endif
18408 end if
18409
18410
18411# 4473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18412
18413# 4473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18414#if defined(MFC_OpenACC)
18415# 4473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18416!$acc parallel loop collapse(3) gang vector default(present)
18417# 4473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18418#elif defined(MFC_OpenMP)
18419# 4473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18420
18421# 4473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18422
18423# 4473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18424
18425# 4473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18426!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18427# 4473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18428#endif
18429 do l = is3%beg, is3%end
18430 do j = is1%beg, is1%end
18431 do k = is2%beg, is2%end
18432 flux_src_vf(eqn_idx%adv%beg)%sf(k, j, l) = flux_src_rsx_vf(k, j, l, eqn_idx%adv%beg)
18433 end do
18434 end do
18435 end do
18436
18437# 4481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18438#if defined(MFC_OpenACC)
18439# 4481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18440!$acc end parallel loop
18441# 4481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18442#elif defined(MFC_OpenMP)
18443# 4481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18444
18445# 4481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18446!$omp end target teams loop
18447# 4481 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18448#endif
18449
18450 if (riemann_solver == 1 .or. riemann_solver == 4) then
18451
18452# 4484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18453
18454# 4484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18455#if defined(MFC_OpenACC)
18456# 4484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18457!$acc parallel loop collapse(4) gang vector default(present)
18458# 4484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18459#elif defined(MFC_OpenMP)
18460# 4484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18461
18462# 4484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18463
18464# 4484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18465
18466# 4484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18467!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18468# 4484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18469#endif
18470 do i = eqn_idx%adv%beg + 1, eqn_idx%adv%end
18471 do l = is3%beg, is3%end
18472 do j = is1%beg, is1%end
18473 do k = is2%beg, is2%end
18474 flux_src_vf(i)%sf(k, j, l) = flux_src_rsx_vf(k, j, l, i)
18475 end do
18476 end do
18477 end do
18478 end do
18479
18480# 4494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18481#if defined(MFC_OpenACC)
18482# 4494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18483!$acc end parallel loop
18484# 4494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18485#elif defined(MFC_OpenMP)
18486# 4494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18487
18488# 4494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18489!$omp end target teams loop
18490# 4494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18491#endif
18492 end if
18493 ! Reshaping Outputted Data in z-direction
18494 else if (norm_dir == 3) then
18495
18496# 4498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18497
18498# 4498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18499#if defined(MFC_OpenACC)
18500# 4498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18501!$acc parallel loop collapse(4) gang vector default(present)
18502# 4498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18503#elif defined(MFC_OpenMP)
18504# 4498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18505
18506# 4498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18507
18508# 4498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18509
18510# 4498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18511!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18512# 4498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18513#endif
18514 do i = 1, sys_size
18515 do j = is1%beg, is1%end
18516 do k = is2%beg, is2%end
18517 do l = is3%beg, is3%end
18518 flux_vf(i)%sf(l, k, j) = flux_rsx_vf(l, k, j, i)
18519 end do
18520 end do
18521 end do
18522 end do
18523
18524# 4508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18525#if defined(MFC_OpenACC)
18526# 4508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18527!$acc end parallel loop
18528# 4508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18529#elif defined(MFC_OpenMP)
18530# 4508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18531
18532# 4508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18533!$omp end target teams loop
18534# 4508 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18535#endif
18536 if (grid_geometry == 3) then
18537
18538# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18539
18540# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18541#if defined(MFC_OpenACC)
18542# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18543!$acc parallel loop collapse(4) gang vector default(present)
18544# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18545#elif defined(MFC_OpenMP)
18546# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18547
18548# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18549
18550# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18551
18552# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18553!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18554# 4510 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18555#endif
18556 do i = 1, sys_size
18557 do j = is1%beg, is1%end
18558 do k = is2%beg, is2%end
18559 do l = is3%beg, is3%end
18560 flux_gsrc_vf(i)%sf(l, k, j) = flux_gsrc_rsx_vf(l, k, j, i)
18561 end do
18562 end do
18563 end do
18564 end do
18565
18566# 4520 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18567#if defined(MFC_OpenACC)
18568# 4520 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18569!$acc end parallel loop
18570# 4520 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18571#elif defined(MFC_OpenMP)
18572# 4520 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18573
18574# 4520 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18575!$omp end target teams loop
18576# 4520 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18577#endif
18578 end if
18579
18580
18581# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18582
18583# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18584#if defined(MFC_OpenACC)
18585# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18586!$acc parallel loop collapse(3) gang vector default(present)
18587# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18588#elif defined(MFC_OpenMP)
18589# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18590
18591# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18592
18593# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18594
18595# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18596!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18597# 4523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18598#endif
18599 do j = is1%beg, is1%end
18600 do k = is2%beg, is2%end
18601 do l = is3%beg, is3%end
18602 flux_src_vf(eqn_idx%adv%beg)%sf(l, k, j) = flux_src_rsx_vf(l, k, j, eqn_idx%adv%beg)
18603 end do
18604 end do
18605 end do
18606
18607# 4531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18608#if defined(MFC_OpenACC)
18609# 4531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18610!$acc end parallel loop
18611# 4531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18612#elif defined(MFC_OpenMP)
18613# 4531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18614
18615# 4531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18616!$omp end target teams loop
18617# 4531 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18618#endif
18619
18620 if (riemann_solver == 1 .or. riemann_solver == 4) then
18621
18622# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18623
18624# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18625#if defined(MFC_OpenACC)
18626# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18627!$acc parallel loop collapse(4) gang vector default(present)
18628# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18629#elif defined(MFC_OpenMP)
18630# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18631
18632# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18633
18634# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18635
18636# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18637!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18638# 4534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18639#endif
18640 do i = eqn_idx%adv%beg + 1, eqn_idx%adv%end
18641 do j = is1%beg, is1%end
18642 do k = is2%beg, is2%end
18643 do l = is3%beg, is3%end
18644 flux_src_vf(i)%sf(l, k, j) = flux_src_rsx_vf(l, k, j, i)
18645 end do
18646 end do
18647 end do
18648 end do
18649
18650# 4544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18651#if defined(MFC_OpenACC)
18652# 4544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18653!$acc end parallel loop
18654# 4544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18655#elif defined(MFC_OpenMP)
18656# 4544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18657
18658# 4544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18659!$omp end target teams loop
18660# 4544 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18661#endif
18662 end if
18663 else if (norm_dir == 1) then
18664
18665# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18666
18667# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18668#if defined(MFC_OpenACC)
18669# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18670!$acc parallel loop collapse(4) gang vector default(present)
18671# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18672#elif defined(MFC_OpenMP)
18673# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18674
18675# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18676
18677# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18678
18679# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18680!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18681# 4547 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18682#endif
18683 do i = 1, sys_size
18684 do l = is3%beg, is3%end
18685 do k = is2%beg, is2%end
18686 do j = is1%beg, is1%end
18687 flux_vf(i)%sf(j, k, l) = flux_rsx_vf(j, k, l, i)
18688 end do
18689 end do
18690 end do
18691 end do
18692
18693# 4557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18694#if defined(MFC_OpenACC)
18695# 4557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18696!$acc end parallel loop
18697# 4557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18698#elif defined(MFC_OpenMP)
18699# 4557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18700
18701# 4557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18702!$omp end target teams loop
18703# 4557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18704#endif
18705
18706
18707# 4559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18708
18709# 4559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18710#if defined(MFC_OpenACC)
18711# 4559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18712!$acc parallel loop collapse(3) gang vector default(present)
18713# 4559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18714#elif defined(MFC_OpenMP)
18715# 4559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18716
18717# 4559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18718
18719# 4559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18720
18721# 4559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18722!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18723# 4559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18724#endif
18725 do l = is3%beg, is3%end
18726 do k = is2%beg, is2%end
18727 do j = is1%beg, is1%end
18728 flux_src_vf(eqn_idx%adv%beg)%sf(j, k, l) = flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg)
18729 end do
18730 end do
18731 end do
18732
18733# 4567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18734#if defined(MFC_OpenACC)
18735# 4567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18736!$acc end parallel loop
18737# 4567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18738#elif defined(MFC_OpenMP)
18739# 4567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18740
18741# 4567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18742!$omp end target teams loop
18743# 4567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18744#endif
18745
18746 if (riemann_solver == 1 .or. riemann_solver == 4) then
18747
18748# 4570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18749
18750# 4570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18751#if defined(MFC_OpenACC)
18752# 4570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18753!$acc parallel loop collapse(4) gang vector default(present)
18754# 4570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18755#elif defined(MFC_OpenMP)
18756# 4570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18757
18758# 4570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18759
18760# 4570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18761
18762# 4570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18763!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18764# 4570 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18765#endif
18766 do i = eqn_idx%adv%beg + 1, eqn_idx%adv%end
18767 do l = is3%beg, is3%end
18768 do k = is2%beg, is2%end
18769 do j = is1%beg, is1%end
18770 flux_src_vf(i)%sf(j, k, l) = flux_src_rsx_vf(j, k, l, i)
18771 end do
18772 end do
18773 end do
18774 end do
18775
18776# 4580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18777#if defined(MFC_OpenACC)
18778# 4580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18779!$acc end parallel loop
18780# 4580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18781#elif defined(MFC_OpenMP)
18782# 4580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18783
18784# 4580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18785!$omp end target teams loop
18786# 4580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18787#endif
18788 end if
18789 end if
18790
18791 end subroutine s_finalize_riemann_solver
18792
18793 !> Module deallocation and/or disassociation procedures
18794 impure subroutine s_finalize_riemann_solvers_module
18795
18796 if (viscous) then
18797#ifdef MFC_DEBUG
18798# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18799 block
18800# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18801 use iso_fortran_env, only: output_unit
18802# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18803
18804# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18805 print *, 'm_riemann_solvers.fpp:4590: ', '@:DEALLOCATE(Re_avg_rsx_vf)'
18806# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18807
18808# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18809 call flush (output_unit)
18810# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18811 end block
18812# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18813#endif
18814# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18815
18816# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18817#if defined(MFC_OpenACC)
18818# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18819!$acc exit data delete(Re_avg_rsx_vf)
18820# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18821#elif defined(MFC_OpenMP)
18822# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18823!$omp target exit data map(release:Re_avg_rsx_vf)
18824# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18825#endif
18826# 4590 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18827 deallocate (re_avg_rsx_vf)
18828 end if
18829#ifdef MFC_DEBUG
18830# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18831 block
18832# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18833 use iso_fortran_env, only: output_unit
18834# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18835
18836# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18837 print *, 'm_riemann_solvers.fpp:4592: ', '@:DEALLOCATE(vel_src_rsx_vf)'
18838# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18839
18840# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18841 call flush (output_unit)
18842# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18843 end block
18844# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18845#endif
18846# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18847
18848# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18849#if defined(MFC_OpenACC)
18850# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18851!$acc exit data delete(vel_src_rsx_vf)
18852# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18853#elif defined(MFC_OpenMP)
18854# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18855!$omp target exit data map(release:vel_src_rsx_vf)
18856# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18857#endif
18858# 4592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18859 deallocate (vel_src_rsx_vf)
18860#ifdef MFC_DEBUG
18861# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18862 block
18863# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18864 use iso_fortran_env, only: output_unit
18865# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18866
18867# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18868 print *, 'm_riemann_solvers.fpp:4593: ', '@:DEALLOCATE(flux_rsx_vf)'
18869# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18870
18871# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18872 call flush (output_unit)
18873# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18874 end block
18875# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18876#endif
18877# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18878
18879# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18880#if defined(MFC_OpenACC)
18881# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18882!$acc exit data delete(flux_rsx_vf)
18883# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18884#elif defined(MFC_OpenMP)
18885# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18886!$omp target exit data map(release:flux_rsx_vf)
18887# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18888#endif
18889# 4593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18890 deallocate (flux_rsx_vf)
18891#ifdef MFC_DEBUG
18892# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18893 block
18894# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18895 use iso_fortran_env, only: output_unit
18896# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18897
18898# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18899 print *, 'm_riemann_solvers.fpp:4594: ', '@:DEALLOCATE(flux_src_rsx_vf)'
18900# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18901
18902# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18903 call flush (output_unit)
18904# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18905 end block
18906# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18907#endif
18908# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18909
18910# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18911#if defined(MFC_OpenACC)
18912# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18913!$acc exit data delete(flux_src_rsx_vf)
18914# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18915#elif defined(MFC_OpenMP)
18916# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18917!$omp target exit data map(release:flux_src_rsx_vf)
18918# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18919#endif
18920# 4594 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18921 deallocate (flux_src_rsx_vf)
18922#ifdef MFC_DEBUG
18923# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18924 block
18925# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18926 use iso_fortran_env, only: output_unit
18927# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18928
18929# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18930 print *, 'm_riemann_solvers.fpp:4595: ', '@:DEALLOCATE(flux_gsrc_rsx_vf)'
18931# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18932
18933# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18934 call flush (output_unit)
18935# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18936 end block
18937# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18938#endif
18939# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18940
18941# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18942#if defined(MFC_OpenACC)
18943# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18944!$acc exit data delete(flux_gsrc_rsx_vf)
18945# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18946#elif defined(MFC_OpenMP)
18947# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18948!$omp target exit data map(release:flux_gsrc_rsx_vf)
18949# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18950#endif
18951# 4595 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18952 deallocate (flux_gsrc_rsx_vf)
18953 if (qbmm) then
18954#ifdef MFC_DEBUG
18955# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18956 block
18957# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18958 use iso_fortran_env, only: output_unit
18959# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18960
18961# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18962 print *, 'm_riemann_solvers.fpp:4597: ', '@:DEALLOCATE(mom_sp_rsx_vf)'
18963# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18964
18965# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18966 call flush (output_unit)
18967# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18968 end block
18969# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18970#endif
18971# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18972
18973# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18974#if defined(MFC_OpenACC)
18975# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18976!$acc exit data delete(mom_sp_rsx_vf)
18977# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18978#elif defined(MFC_OpenMP)
18979# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18980!$omp target exit data map(release:mom_sp_rsx_vf)
18981# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18982#endif
18983# 4597 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18984 deallocate (mom_sp_rsx_vf)
18985 end if
18986
18987 end subroutine s_finalize_riemann_solvers_module
18988
18989end module m_riemann_solvers
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1067
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1067
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1067
m_bubbles_ee
Computes ensemble-averaged (Euler–Euler) bubble source terms for radius, velocity,...
Definition m_bubbles_EE.fpp.f90:317
m_bubbles_ee::vs
integer, dimension(:), allocatable vs
Definition m_bubbles_EE.fpp.f90:354
m_bubbles_ee::ps
integer, dimension(:), allocatable ps
Definition m_bubbles_EE.fpp.f90:354
m_bubbles_ee::rs
integer, dimension(:), allocatable rs
Definition m_bubbles_EE.fpp.f90:354
m_bubbles
Bubble-dynamics procedures for ensemble- and volume-averaged models.
Definition m_bubbles.fpp.f90:317
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:615
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:369
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
Definition m_global_parameters.fpp.f90:361
m_global_parameters::re_size
integer, dimension(2) re_size
Definition m_global_parameters.fpp.f90:912
m_global_parameters::bulk_stress
logical bulk_stress
Bulk stresses.
Definition m_global_parameters.fpp.f90:595
m_global_parameters::grid_geometry
integer grid_geometry
Definition m_global_parameters.fpp.f90:498
m_global_parameters::wave_speeds
integer wave_speeds
Definition m_global_parameters.fpp.f90:457
m_global_parameters::cont_damage
logical cont_damage
Definition m_global_parameters.fpp.f90:370
m_global_parameters::hypoelasticity
logical hypoelasticity
Definition m_global_parameters.fpp.f90:385
m_global_parameters::avg_state
integer avg_state
Definition m_global_parameters.fpp.f90:356
m_global_parameters::chemistry
logical, parameter chemistry
Chemistry modeling.
Definition m_global_parameters.fpp.f90:593
m_global_parameters::num_fluids
integer num_fluids
Definition m_global_parameters.fpp.f90:565
m_global_parameters::re_idx
integer, dimension(:,:), allocatable re_idx
Definition m_global_parameters.fpp.f90:914
m_global_parameters::weno_re_flux
logical weno_re_flux
Definition m_global_parameters.fpp.f90:458
m_global_parameters::hyper_cleaning_speed
real(wp) hyper_cleaning_speed
Definition m_global_parameters.fpp.f90:382
m_global_parameters::sys_size
integer sys_size
Number of unknowns in system of eqns.
Definition m_global_parameters.fpp.f90:862
m_global_parameters::weight
real(wp), dimension(:), allocatable weight
Simpson quadrature weights.
Definition m_global_parameters.fpp.f90:1086
m_global_parameters::cyl_coord
logical cyl_coord
Definition m_global_parameters.fpp.f90:372
m_global_parameters::dir_idx
integer, dimension(3) dir_idx
Definition m_global_parameters.fpp.f90:950
m_global_parameters::viscous
logical viscous
Definition m_global_parameters.fpp.f90:577
m_global_parameters::riemann_solver
integer riemann_solver
Definition m_global_parameters.fpp.f90:439
m_global_parameters::model_eqns
integer model_eqns
Definition m_global_parameters.fpp.f90:400
m_global_parameters::hyperelasticity
logical hyperelasticity
Definition m_global_parameters.fpp.f90:384
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:1000
m_global_parameters::dir_idx_tau
integer, dimension(3) dir_idx_tau
used for hypoelasticity=true
Definition m_global_parameters.fpp.f90:952
m_global_parameters::num_dims
integer num_dims
Number of spatial dimensions.
Definition m_global_parameters.fpp.f90:554
m_global_parameters::r0
real(wp), dimension(:), allocatable r0
Bubble sizes.
Definition m_global_parameters.fpp.f90:1087
m_global_parameters::chem_params
type(chemistry_parameters) chem_params
Definition m_global_parameters.fpp.f90:1193
m_global_parameters::num_vels
integer num_vels
Number of velocity components (different from num_dims for mhd).
Definition m_global_parameters.fpp.f90:555
m_global_parameters::polytropic
logical polytropic
Definition m_global_parameters.fpp.f90:428
m_global_parameters::qbmm
logical qbmm
Definition m_global_parameters.fpp.f90:434
m_global_parameters::hyper_cleaning
logical hyper_cleaning
Definition m_global_parameters.fpp.f90:381
m_global_parameters::bx0
real(wp) bx0
Definition m_global_parameters.fpp.f90:343
m_global_parameters::b_size
integer b_size
Number of elements in the symmetric b tensor, plus one.
Definition m_global_parameters.fpp.f90:865
m_global_parameters::qvs
real(wp), dimension(:), allocatable qvs
Definition m_global_parameters.fpp.f90:1304
m_global_parameters::pi_infs
real(wp), dimension(:), allocatable pi_infs
Definition m_global_parameters.fpp.f90:1304
m_global_parameters::adv_n
logical adv_n
Definition m_global_parameters.fpp.f90:352
m_global_parameters::dir_flg
real(wp), dimension(3) dir_flg
Definition m_global_parameters.fpp.f90:951
m_global_parameters::mhd
logical mhd
Definition m_global_parameters.fpp.f90:571
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:981
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:404
m_global_parameters::surface_tension
logical surface_tension
Definition m_global_parameters.fpp.f90:442
m_global_parameters::elasticity
logical elasticity
elasticity modeling, true for hyper or hypo
Definition m_global_parameters.fpp.f90:592
m_global_parameters::nb
integer nb
Definition m_global_parameters.fpp.f90:1070
m_global_parameters::mpp_lim
logical mpp_lim
Definition m_global_parameters.fpp.f90:402
m_global_parameters::low_mach
integer low_mach
Definition m_global_parameters.fpp.f90:397
m_global_parameters::shear_stress
logical shear_stress
Shear stresses.
Definition m_global_parameters.fpp.f90:594
m_global_parameters::relativity
logical relativity
Definition m_global_parameters.fpp.f90:572
m_global_parameters::gammas
real(wp), dimension(:), allocatable gammas
Definition m_global_parameters.fpp.f90:1304
m_global_parameters::eqn_idx
type(eqn_idx_info) eqn_idx
All conserved-variable equation index ranges and scalars.
Definition m_global_parameters.fpp.f90:863
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::is2
type(int_bounds_info) is2
Definition m_riemann_solvers.fpp.f90:435
m_riemann_solvers::re_avg_rsx_vf
real(wp), dimension(:,:,:,:), allocatable re_avg_rsx_vf
Definition m_riemann_solvers.fpp.f90:420
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:17876
m_riemann_solvers::s_lf_riemann_solver
subroutine, public s_lf_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_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:3623
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:18089
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:18281
m_riemann_solvers::s_populate_riemann_states_variables_buffers
subroutine s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, qr_prim_rsx_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:16376
m_riemann_solvers::res_gs
real(wp), dimension(:,:), allocatable res_gs
Definition m_riemann_solvers.fpp.f90:464
m_riemann_solvers::vel_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable vel_src_rsx_vf
Definition m_riemann_solvers.fpp.f90:394
m_riemann_solvers::is1
type(int_bounds_info) is1
Definition m_riemann_solvers.fpp.f90:435
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:18317
m_riemann_solvers::isx
type(int_bounds_info) isx
Definition m_riemann_solvers.fpp.f90:436
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:18795
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:18238
m_riemann_solvers::is3
type(int_bounds_info) is3
Definition m_riemann_solvers.fpp.f90:435
m_riemann_solvers::flux_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_src_rsx_vf
Definition m_riemann_solvers.fpp.f90:361
m_riemann_solvers::s_riemann_solver
subroutine, public s_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_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:485
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:17455
m_riemann_solvers::s_hllc_riemann_solver
subroutine, public s_hllc_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_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:6410
m_riemann_solvers::mom_sp_rsx_vf
real(wp), dimension(:,:,:,:), allocatable mom_sp_rsx_vf
Definition m_riemann_solvers.fpp.f90:407
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:378
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:361
m_riemann_solvers::isy
type(int_bounds_info) isy
Definition m_riemann_solvers.fpp.f90:436
m_riemann_solvers::s_hll_riemann_solver
subroutine, public s_hll_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_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:553
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:16042
m_riemann_solvers::isz
type(int_bounds_info) isz
Definition m_riemann_solvers.fpp.f90:436
m_riemann_solvers::s_hlld_riemann_solver
subroutine, public s_hlld_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_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:15265
m_riemann_solvers::gs_rs
real(wp), dimension(:), allocatable gs_rs
Definition m_riemann_solvers.fpp.f90:451
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:530
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, flux_src_vf, id, isx, isy, isz)
Compute the capillary source flux from reconstructed color-gradient fields.
Definition m_surface_tension.fpp.f90:595
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:328
m_variables_conversion::s_compute_fast_magnetosonic_speed
subroutine s_compute_fast_magnetosonic_speed(rho, c, b, norm, c_fast, h)
Compute the fast magnetosonic wave speed from the sound speed, density, and magnetic field components...
Definition m_variables_conversion.fpp.f90:2640
m_variables_conversion::s_compute_speed_of_sound
subroutine s_compute_speed_of_sound(pres, rho, gamma, pi_inf, h, adv, vel_sum, c_c, c, qv)
Compute the speed of sound from thermodynamic state variables, supporting multiple equation-of-state ...
Definition m_variables_conversion.fpp.f90:2556
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:411
m_derived_types::riemann_states_vec3
Left and right Riemann states for 3-component vectors.
Definition m_derived_types.fpp.f90:399
m_derived_types::riemann_states
Left and right Riemann states.
Definition m_derived_types.fpp.f90:393
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:331