MFC
Exascale flow solver
Loading...
Searching...
No Matches
m_riemann_solvers.fpp.f90
Go to the documentation of this file.
1# 1 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2!>
3!! @file
4!! @brief Contains module m_riemann_solvers
5
6!> @brief Approximate and exact Riemann solvers (HLL, HLLC, HLLD, exact) for the multicomponent Navier--Stokes equations
7
8# 1 "/home/runner/work/MFC/MFC/src/common/include/case.fpp" 1
9! This file exists so that Fypp can be run without generating case.fpp files for
10! each target. This is useful when generating documentation, for example. This
11! should also let MFC be built with CMake directly, without invoking mfc.sh.
12
13! For pre-process.
14# 9 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
15
16! For moving immersed boundaries in simulation
17# 14 "/home/runner/work/MFC/MFC/src/common/include/case.fpp"
18# 8 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp" 2
19# 1 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 1
20# 1 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 1
21# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
22# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
23# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
24# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
25# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
26# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
27
28# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
29# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
30# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
31
32# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
33
34# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
35
36# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
37
38# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
39
40# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
41
42# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
43
44# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
45! New line at end of file is required for FYPP
46# 2 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
47# 1 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 1
48# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
49# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
50# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
51# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
52# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
53# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
54
55# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
56# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
57# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
58
59# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
60
61# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
62
63# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
64
65# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
66
67# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
68
69# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
70
71# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
72! New line at end of file is required for FYPP
73# 2 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp" 2
74
75# 4 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
76# 5 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
77# 6 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
78# 7 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
79# 8 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
80
81# 20 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
82
83# 43 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
84
85# 48 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
86
87# 53 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
88
89# 58 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
90
91# 63 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
92
93# 68 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
94
95# 76 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
96
97# 81 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
98
99# 86 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
100
101# 91 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
102
103# 96 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
104
105# 101 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
106
107# 106 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
108
109# 111 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
110
111# 116 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
112
113# 121 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
114
115# 151 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
116
117# 192 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
118
119# 206 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 231 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 242 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 244 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
126# 255 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
127
128# 284 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 294 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 304 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 313 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 330 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 340 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 347 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 353 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 359 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 365 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 371 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 377 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
151! New line at end of file is required for FYPP
152# 3 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
153# 1 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 1
154# 1 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp" 1
155# 2 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
156# 3 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
157# 4 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
158# 5 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
159# 6 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
160
161# 8 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
162# 9 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
163# 10 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
164
165# 17 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
166
167# 46 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
168
169# 58 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
170
171# 68 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
172
173# 98 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
174
175# 110 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
176
177# 120 "/home/runner/work/MFC/MFC/src/common/include/shared_parallel_macros.fpp"
178! New line at end of file is required for FYPP
179# 2 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp" 2
180
181# 7 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
182
183# 17 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
184
185# 22 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
186
187# 27 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
188
189# 32 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
190
191# 37 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
192
193# 42 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
194
195# 47 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
196
197# 52 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
198
199# 57 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
200
201# 62 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
202
203# 73 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
204
205# 78 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
206
207# 83 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
208
209# 88 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
210
211# 103 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
212
213# 131 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
214
215# 160 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
216
217# 175 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
218
219# 193 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 215 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 244 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 259 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 269 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 278 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 294 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 304 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 311 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
236! New line at end of file is required for FYPP
237# 4 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp" 2
238
239! GPU parallel region (scalar reductions, maxval/minval)
240# 23 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
241
242! GPU parallel loop over threads (most common GPU macro)
243# 43 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
244
245! Required closing for GPU_PARALLEL_LOOP
246# 55 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
247
248! Mark routine for device compilation
249# 112 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
250
251! Declare device-resident data
252# 130 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
253
254! Inner loop within a GPU parallel region
255# 145 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
256
257! Scoped GPU data region
258# 164 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
259
260! Host code with device pointers (for MPI with GPU buffers)
261# 193 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
262
263! Allocate device memory (unscoped)
264# 207 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
265
266! Free device memory
267# 219 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
268
269! Atomic operation on device
270# 231 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
271
272! End atomic capture block
273# 242 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
274
275! Copy data between host and device
276# 254 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
277
278! Synchronization barrier
279# 266 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
280
281! Import GPU library module (openacc or omp_lib)
282# 275 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
283
284! Emit code only for AMD compiler
285# 282 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
286
287! Emit code for non-Cray compilers
288# 289 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
289
290! Emit code only for Cray compiler
291# 296 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
292
293! Emit code for non-NVIDIA compilers
294# 303 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
295
296# 305 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
297# 306 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
298! New line at end of file is required for FYPP
299# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
300
301# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
302
303! Caution: This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI
304! rank. That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0. For an
305! example see misc/nvidia_uvm/bind.sh. NVIDIA unified memory page placement hint
306# 57 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
307
308! Allocate and create GPU device memory
309# 77 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
310
311! Free GPU device memory and deallocate
312# 85 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
313
314! Cray-specific GPU pointer setup for vector fields
315# 109 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
316
317! Cray-specific GPU pointer setup for scalar fields
318# 125 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
319
320! Cray-specific GPU pointer setup for acoustic source spatials
321# 150 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
322
323# 156 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
324
325# 163 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
326! New line at end of file is required for FYPP
327# 9 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp" 2
328# 1 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp" 1
329# 13 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
330
331# 83 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
332
333# 93 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
334
335# 117 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
336# 10 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp" 2
337
338module m_riemann_solvers
339
340 use m_derived_types
341 use m_global_parameters
342 use m_mpi_proxy
343 use m_variables_conversion
344 use m_bubbles
345 use m_bubbles_ee
346 use m_surface_tension
347 use m_helper_basic
348 use m_chemistry
349 use m_thermochem, only: gas_constant, get_mixture_molecular_weight, get_mixture_specific_heat_cv_mass, &
350 & get_mixture_energy_mass, get_species_specific_heats_r, get_species_enthalpies_rt, get_mixture_specific_heat_cp_mass
351
352# 28 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
353
354 implicit none
355
356 private; public :: s_initialize_riemann_solvers_module, s_riemann_solver, s_hll_riemann_solver, s_hllc_riemann_solver, &
357 & s_hlld_riemann_solver, s_lf_riemann_solver, s_finalize_riemann_solvers_module
358
359 !> The cell-boundary values of the fluxes (src - source) that are computed through the chosen Riemann problem solver, and the
360 !! direct evaluation of source terms, by using the left and right states given in qK_prim_rs_vf, dqK_prim_ds_vf where ds = dx,
361 !! dy or dz.
362 !> @{
363 real(wp), allocatable, dimension(:,:,:,:) :: flux_rsx_vf, flux_src_rsx_vf
364
365# 39 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
366#if defined(MFC_OpenACC)
367# 39 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
368!$acc declare create(flux_rsx_vf, flux_src_rsx_vf)
369# 39 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
370#elif defined(MFC_OpenMP)
371# 39 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
372!$omp declare target (flux_rsx_vf, flux_src_rsx_vf)
373# 39 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
374#endif
375 !> @}
376
377 !> The cell-boundary values of the geometrical source flux that are computed through the chosen Riemann problem solver by using
378 !! the left and right states given in qK_prim_rs_vf. Currently 2D axisymmetric for inviscid only.
379 !> @{
380 real(wp), allocatable, dimension(:,:,:,:) :: flux_gsrc_rsx_vf
381
382# 46 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
383#if defined(MFC_OpenACC)
384# 46 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
385!$acc declare create(flux_gsrc_rsx_vf)
386# 46 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
387#elif defined(MFC_OpenMP)
388# 46 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
389!$omp declare target (flux_gsrc_rsx_vf)
390# 46 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
391#endif
392 !> @}
393
394 ! Cell-boundary velocity from Riemann solution; used for source flux
395
396 real(wp), allocatable, dimension(:,:,:,:) :: vel_src_rsx_vf
397
398# 52 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
399#if defined(MFC_OpenACC)
400# 52 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
401!$acc declare create(vel_src_rsx_vf)
402# 52 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
403#elif defined(MFC_OpenMP)
404# 52 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
405!$omp declare target (vel_src_rsx_vf)
406# 52 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
407#endif
408
409 real(wp), allocatable, dimension(:,:,:,:) :: mom_sp_rsx_vf
410
411# 55 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
412#if defined(MFC_OpenACC)
413# 55 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
414!$acc declare create(mom_sp_rsx_vf)
415# 55 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
416#elif defined(MFC_OpenMP)
417# 55 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
418!$omp declare target (mom_sp_rsx_vf)
419# 55 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
420#endif
421
422 real(wp), allocatable, dimension(:,:,:,:) :: re_avg_rsx_vf
423
424# 58 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
425#if defined(MFC_OpenACC)
426# 58 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
427!$acc declare create(Re_avg_rsx_vf)
428# 58 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
429#elif defined(MFC_OpenMP)
430# 58 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
431!$omp declare target (Re_avg_rsx_vf)
432# 58 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
433#endif
434
435 !> @name Indical bounds in the s1-, s2- and s3-directions
436 !> @{
437 type(int_bounds_info) :: is1, is2, is3
438 type(int_bounds_info) :: isx, isy, isz
439 !> @}
440
441
442# 66 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
443#if defined(MFC_OpenACC)
444# 66 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
445!$acc declare create(is1, is2, is3, isx, isy, isz)
446# 66 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
447#elif defined(MFC_OpenMP)
448# 66 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
449!$omp declare target (is1, is2, is3, isx, isy, isz)
450# 66 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
451#endif
452
453 real(wp), allocatable, dimension(:) :: gs_rs
454
455# 69 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
456#if defined(MFC_OpenACC)
457# 69 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
458!$acc declare create(Gs_rs)
459# 69 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
460#elif defined(MFC_OpenMP)
461# 69 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
462!$omp declare target (Gs_rs)
463# 69 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
464#endif
465
466 real(wp), allocatable, dimension(:,:) :: res_gs
467
468# 72 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
469#if defined(MFC_OpenACC)
470# 72 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
471!$acc declare create(Res_gs)
472# 72 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
473#elif defined(MFC_OpenMP)
474# 72 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
475!$omp declare target (Res_gs)
476# 72 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
477#endif
478
479contains
480
481 !> Dispatch to the subroutines that are utilized to compute the Riemann problem solution. For additional information please
482 !! reference: 1) s_hll_riemann_solver 2) s_hllc_riemann_solver 3) s_lf_riemann_solver 4) s_hlld_riemann_solver
483 subroutine s_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, &
484
485 & 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, &
486 & flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
487
488 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, qr_prim_rsx_vf
489 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
490 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
491 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
492 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
493
494 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
495 integer, intent(in) :: norm_dir
496 type(int_bounds_info), intent(in) :: ix, iy, iz
497
498# 94 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
499 if (riemann_solver == 1) then
500 call s_hll_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, &
501 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, &
502 & q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
503 end if
504# 94 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
505 if (riemann_solver == 2) then
506 call s_hllc_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, &
507 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, &
508 & q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
509 end if
510# 94 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
511 if (riemann_solver == 4) then
512 call s_hlld_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, &
513 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, &
514 & q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
515 end if
516# 94 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
517 if (riemann_solver == 5) then
518 call s_lf_riemann_solver(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, &
519 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, &
520 & q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
521 end if
522# 100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
523
524 end subroutine s_riemann_solver
525
526 !> Dispatch to the subroutines that are utilized to compute the viscous source fluxes for either Cartesian or cylindrical
527 !! geometries. For more information please refer to: 1) s_compute_cartesian_viscous_source_flux 2)
528 !! s_compute_cylindrical_viscous_source_flux
529 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, &
530
531 & dvelR_dz_vf, flux_src_vf, norm_dir, ix, iy, iz)
532
533 type(scalar_field), dimension(num_vels), intent(in) :: velL_vf, velR_vf, dvelL_dx_vf, dvelR_dx_vf, dvelL_dy_vf, &
534 & dvelR_dy_vf, dvelL_dz_vf, dvelR_dz_vf
535
536 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
537 integer, intent(in) :: norm_dir
538 type(int_bounds_info), intent(in) :: ix, iy, iz
539
540 if (grid_geometry == 3) then
541 call s_compute_cylindrical_viscous_source_flux(vell_vf, dvell_dx_vf, dvell_dy_vf, dvell_dz_vf, velr_vf, dvelr_dx_vf, &
542 & dvelr_dy_vf, dvelr_dz_vf, flux_src_vf, norm_dir, ix, iy, iz)
543 else
544 call s_compute_cartesian_viscous_source_flux(dvell_dx_vf, dvell_dy_vf, dvell_dz_vf, dvelr_dx_vf, dvelr_dy_vf, &
545 & dvelr_dz_vf, flux_src_vf, norm_dir)
546 end if
547
548 end subroutine s_compute_viscous_source_flux
549
550 !> HLL approximate Riemann solver, Harten et al. SIAM Review (1983)
551 subroutine s_hll_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, &
552
553 & 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, &
554 & flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
555
556 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, qr_prim_rsx_vf
557 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
558 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
559 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
560 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
561
562 ! Intercell fluxes
563 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
564 real(wp) :: flux_tau_l, flux_tau_r
565 integer, intent(in) :: norm_dir
566 type(int_bounds_info), intent(in) :: ix, iy, iz
567
568# 153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
569 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
570 real(wp), dimension(num_vels) :: vel_l, vel_r
571 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
572 real(wp), dimension(num_species) :: ys_l, ys_r
573 real(wp), dimension(num_species) :: cp_il, cp_ir, xs_l, xs_r, gamma_il, gamma_ir
574 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
575# 160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
576 real(wp) :: rho_l, rho_r
577 real(wp) :: pres_l, pres_r
578 real(wp) :: e_l, e_r
579 real(wp) :: h_l, h_r
580 real(wp) :: cp_avg, cv_avg, t_avg, eps, c_sum_yi_phi
581 real(wp) :: t_l, t_r
582 real(wp) :: y_l, y_r
583 real(wp) :: mw_l, mw_r
584 real(wp) :: r_gas_l, r_gas_r
585 real(wp) :: cp_l, cp_r
586 real(wp) :: cv_l, cv_r
587 real(wp) :: gamm_l, gamm_r
588 real(wp) :: gamma_l, gamma_r
589 real(wp) :: pi_inf_l, pi_inf_r
590 real(wp) :: qv_l, qv_r
591 real(wp) :: c_l, c_r
592 real(wp), dimension(6) :: tau_e_l, tau_e_r
593 real(wp) :: g_l, g_r
594 real(wp), dimension(2) :: re_l, re_r
595 real(wp), dimension(3) :: xi_field_l, xi_field_r
596 real(wp) :: rho_avg
597 real(wp) :: h_avg
598 real(wp) :: qv_avg
599 real(wp) :: gamma_avg
600 real(wp) :: c_avg
601 real(wp) :: s_l, s_r, s_m, s_p, s_s
602 real(wp) :: xi_m, xi_p
603 real(wp) :: ptilde_l, ptilde_r
604 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
605 real(wp) :: vel_l_tmp, vel_r_tmp
606 real(wp) :: ms_l, ms_r, pres_sl, pres_sr
607 real(wp) :: alpha_l_sum, alpha_r_sum
608 real(wp) :: zcoef, pcorr !< low Mach number correction
609 type(riemann_states) :: c_fast, pres_mag
610 type(riemann_states_vec3) :: b
611 type(riemann_states) :: ga !< Gamma (Lorentz factor)
612 type(riemann_states) :: vdotb, b2
613 type(riemann_states_vec3) :: b4 !< 4-magnetic field components (spatial: b4x, b4y, b4z)
614 type(riemann_states_vec3) :: cm !< Conservative momentum variables
615 integer :: i, j, k, l, q !< Generic loop iterators
616 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
617
618 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
619 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
620
621 ! Reshaping inputted data based on dimensional splitting direction
622 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
623# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
624# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
625# 213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
626 if (norm_dir == 1) then
627
628# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
629
630# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
631#if defined(MFC_OpenACC)
632# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
633!$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)
634# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
635#elif defined(MFC_OpenMP)
636# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
637
638# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
639
640# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
641
642# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
643!$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)
644# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
645#endif
646# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
647 do l = is3%beg, is3%end
648 do k = is2%beg, is2%end
649 do j = is1%beg, is1%end
650
651# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
652#if defined(MFC_OpenACC)
653# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
654!$acc loop seq
655# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
656#elif defined(MFC_OpenMP)
657# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
658
659# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
660#endif
661 do i = 1, eqn_idx%cont%end
662 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
663 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
664 end do
665
666 vel_l_rms = 0._wp; vel_r_rms = 0._wp
667
668
669# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
670#if defined(MFC_OpenACC)
671# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
672!$acc loop seq
673# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
674#elif defined(MFC_OpenMP)
675# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
676
677# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
678#endif
679 do i = 1, num_vels
680 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
681 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
682 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
683 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
684 end do
685
686
687# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
688#if defined(MFC_OpenACC)
689# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
690!$acc loop seq
691# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
692#elif defined(MFC_OpenMP)
693# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
694
695# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
696#endif
697 do i = 1, num_fluids
698 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
699 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
700 end do
701
702 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
703 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
704
705 if (mhd) then
706 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
707 b%L(1) = bx0
708 b%R(1) = bx0
709 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
710 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg)
711 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
712 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 1)
713 else ! 2D/3D: Bx, By, Bz as variables
714 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
715 b%R(1) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg)
716 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
717 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 1)
718 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
719 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 2)
720 end if
721 end if
722
723 rho_l = 0._wp
724 gamma_l = 0._wp
725 pi_inf_l = 0._wp
726 qv_l = 0._wp
727
728 rho_r = 0._wp
729 gamma_r = 0._wp
730 pi_inf_r = 0._wp
731 qv_r = 0._wp
732
733 alpha_l_sum = 0._wp
734 alpha_r_sum = 0._wp
735
736 pres_mag%L = 0._wp
737 pres_mag%R = 0._wp
738
739 if (mpp_lim) then
740
741# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
742#if defined(MFC_OpenACC)
743# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
744!$acc loop seq
745# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
746#elif defined(MFC_OpenMP)
747# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
748
749# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
750#endif
751 do i = 1, num_fluids
752 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
753 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
754 alpha_l_sum = alpha_l_sum + alpha_l(i)
755 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
756 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
757 alpha_r_sum = alpha_r_sum + alpha_r(i)
758 end do
759
760 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
761 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
762 end if
763
764
765# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
766#if defined(MFC_OpenACC)
767# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
768!$acc loop seq
769# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
770#elif defined(MFC_OpenMP)
771# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
772
773# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
774#endif
775 do i = 1, num_fluids
776 rho_l = rho_l + alpha_rho_l(i)
777 gamma_l = gamma_l + alpha_l(i)*gammas(i)
778 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
779 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
780
781 rho_r = rho_r + alpha_rho_r(i)
782 gamma_r = gamma_r + alpha_r(i)*gammas(i)
783 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
784 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
785 end do
786
787 if (viscous) then
788
789# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
790#if defined(MFC_OpenACC)
791# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
792!$acc loop seq
793# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
794#elif defined(MFC_OpenMP)
795# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
796
797# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
798#endif
799 do i = 1, 2
800 re_l(i) = dflt_real
801 re_r(i) = dflt_real
802
803 if (re_size(i) > 0) re_l(i) = 0._wp
804 if (re_size(i) > 0) re_r(i) = 0._wp
805
806
807# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
808#if defined(MFC_OpenACC)
809# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
810!$acc loop seq
811# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
812#elif defined(MFC_OpenMP)
813# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
814
815# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
816#endif
817 do q = 1, re_size(i)
818 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
819 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
820 end do
821
822 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
823 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
824 end do
825 end if
826
827 if (chemistry) then
828
829# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
830#if defined(MFC_OpenACC)
831# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
832!$acc loop seq
833# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
834#elif defined(MFC_OpenMP)
835# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
836
837# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
838#endif
839 do i = eqn_idx%species%beg, eqn_idx%species%end
840 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
841 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
842 end do
843
844 call get_mixture_molecular_weight(ys_l, mw_l)
845 call get_mixture_molecular_weight(ys_r, mw_r)
846# 346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
847 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
848 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
849# 349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
850
851 r_gas_l = gas_constant/mw_l
852 r_gas_r = gas_constant/mw_r
853 t_l = pres_l/rho_l/r_gas_l
854 t_r = pres_r/rho_r/r_gas_r
855
856 call get_species_specific_heats_r(t_l, cp_il)
857 call get_species_specific_heats_r(t_r, cp_ir)
858
859 if (chem_params%gamma_method == 1) then
860 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
861 gamma_il = cp_il/(cp_il - 1.0_wp)
862 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
863
864 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
865 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
866 else if (chem_params%gamma_method == 2) then
867 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
868 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
869 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
870 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
871 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
872
873 gamm_l = cp_l/cv_l
874 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
875 gamm_r = cp_r/cv_r
876 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
877 end if
878
879 call get_mixture_energy_mass(t_l, ys_l, e_l)
880 call get_mixture_energy_mass(t_r, ys_r, e_r)
881
882 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
883 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
884 h_l = (e_l + pres_l)/rho_l
885 h_r = (e_r + pres_r)/rho_r
886 else if (mhd .and. relativity) then
887 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
888 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
889# 389 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
890 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
891 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
892
893 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
894 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
895 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
896 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
897# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
898
899 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
900 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
901
902 ! Hard-coded EOS
903 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
904 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
905# 405 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
906 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
907 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
908# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
909
910 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
911 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
912 else if (mhd .and. .not. relativity) then
913# 413 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
914 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
915 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
916# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
917 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
918 ! includes magnetic energy
919 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R
920 h_l = (e_l + pres_l - pres_mag%L)/rho_l
921 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
922 h_r = (e_r + pres_r - pres_mag%R)/rho_r
923 else
924 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
925 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
926 h_l = (e_l + pres_l)/rho_l
927 h_r = (e_r + pres_r)/rho_r
928 end if
929
930 ! elastic energy update
931 if (hypoelasticity) then
932 g_l = 0._wp; g_r = 0._wp
933
934
935# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
936#if defined(MFC_OpenACC)
937# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
938!$acc loop seq
939# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
940#elif defined(MFC_OpenMP)
941# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
942
943# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
944#endif
945 do i = 1, num_fluids
946 g_l = g_l + alpha_l(i)*gs_rs(i)
947 g_r = g_r + alpha_r(i)*gs_rs(i)
948 end do
949
950 if (cont_damage) then
951 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
952 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
953 end if
954
955
956# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
957#if defined(MFC_OpenACC)
958# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
959!$acc loop seq
960# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
961#elif defined(MFC_OpenMP)
962# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
963
964# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
965#endif
966 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
967 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
968 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
969 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
970 if ((g_l > 1000) .and. (g_r > 1000)) 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 ! Double for shear stresses
974 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
975 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
976 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
977 end if
978 end if
979 end do
980 end if
981
982 if (avg_state == 1) then
983# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
984 rho_avg = sqrt(rho_l*rho_r)
985# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
986
987# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
988 vel_avg_rms = 0._wp
989# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
990
991# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
992
993# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
994#if defined(MFC_OpenACC)
995# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
996!$acc loop seq
997# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
998#elif defined(MFC_OpenMP)
999# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1000
1001# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1002#endif
1003# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1004 do i = 1, num_vels
1005# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1006 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
1007# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1008 end do
1009# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1010
1011# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1012 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
1013# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1014
1015# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1016 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
1017# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1018
1019# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1020 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
1021# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1022
1023# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1024 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
1025# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1026
1027# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1028 if (chemistry) then
1029# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1030 eps = 0.001_wp
1031# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1032 call get_species_enthalpies_rt(t_l, h_il)
1033# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1034 call get_species_enthalpies_rt(t_r, h_ir)
1035# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1036 h_il = h_il*gas_constant/molecular_weights*t_l
1037# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1038 h_ir = h_ir*gas_constant/molecular_weights*t_r
1039# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1040 call get_species_specific_heats_r(t_l, cp_il)
1041# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1042 call get_species_specific_heats_r(t_r, cp_ir)
1043# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1044
1045# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1046 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
1047# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1048 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
1049# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1050 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
1051# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1052 if (abs(t_l - t_r) < eps) then
1053# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1054 ! Case when T_L and T_R are very close
1055# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1056 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
1057# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1058 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
1059# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1060 & - gas_constant/molecular_weights(:)))
1061# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1062 else
1063# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1064 ! Normal calculation when T_L and T_R are sufficiently different
1065# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1066 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
1067# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1068 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
1069# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1070 end if
1071# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1072 gamma_avg = cp_avg/cv_avg
1073# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1074
1075# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1076 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
1077# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1078 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
1079# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1080 end if
1081# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1082 end if
1083# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1084
1085# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1086 if (avg_state == 2) then
1087# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1088 rho_avg = 5.e-1_wp*(rho_l + rho_r)
1089# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1090 vel_avg_rms = 0._wp
1091# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1092
1093# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1094#if defined(MFC_OpenACC)
1095# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1096!$acc loop seq
1097# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1098#elif defined(MFC_OpenMP)
1099# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1100
1101# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1102#endif
1103# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1104 do i = 1, num_vels
1105# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1106 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
1107# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1108 end do
1109# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1110
1111# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1112 h_avg = 5.e-1_wp*(h_l + h_r)
1113# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1114 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
1115# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1116 qv_avg = 5.e-1_wp*(qv_l + qv_r)
1117# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1118 end if
1119
1120 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, &
1121 & qv_l)
1122
1123 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, &
1124 & qv_r)
1125
1126 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
1127 ! variables are placeholders to call the subroutine.
1128
1129 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
1130 & c_sum_yi_phi, c_avg, qv_avg)
1131
1132 if (mhd) then
1133 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
1134 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
1135 end if
1136
1137 if (viscous) then
1138 if (chemistry) then
1139 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
1140 end if
1141
1142# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1143#if defined(MFC_OpenACC)
1144# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1145!$acc loop seq
1146# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1147#elif defined(MFC_OpenMP)
1148# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1149
1150# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1151#endif
1152 do i = 1, 2
1153 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
1154 end do
1155 end if
1156
1157 ! Wave speed estimates (wave_speeds=1: direct, wave_speeds=2: pressure-based)
1158 if (wave_speeds == 1) then
1159 if (mhd) then
1160 ! MHD: use fast magnetosonic speed
1161 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
1162 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
1163 else if (hypoelasticity) then
1164 ! Elastic wave speed, Rodriguez et al. JCP (2019)
1165 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))) &
1166 & /rho_l), &
1167 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
1168 & /rho_r))
1169 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))) &
1170 & /rho_r), &
1171 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
1172 & /rho_l))
1173 else if (hyperelasticity) then
1174 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l), &
1175 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
1176 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r), &
1177 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
1178 else
1179 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
1180 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
1181 end if
1182
1183 if (hyper_cleaning) then
1184 ! Dedner GLM divergence cleaning, Dedner et al. JCP (2002)
1185 s_l = min(s_l, -hyper_cleaning_speed)
1186 s_r = max(s_r, hyper_cleaning_speed)
1187 end if
1188
1189 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
1190 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
1191 & - rho_r*(s_r - vel_r(dir_idx(1))))
1192 else if (wave_speeds == 2) then
1193 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
1194
1195 pres_sr = pres_sl
1196
1197 ! Low Mach correction: Thornber et al. JCP (2008)
1198 ms_l = max(1._wp, &
1199 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
1200 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
1201 ms_r = max(1._wp, &
1202 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
1203 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
1204
1205 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1206 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1207
1208 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
1209 end if
1210
1211 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1212
1213 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, &
1214 & s_r))
1215 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, &
1216 & s_r))
1217
1218 ! 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
1219 if (low_mach == 1) then
1220 if (riemann_solver == 1 .or. riemann_solver == 5) then
1221# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1222 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1223# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1224 pcorr = 0._wp
1225# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1226
1227# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1228 if (low_mach == 1) then
1229# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1230 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
1231# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1232 end if
1233# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1234 else if (riemann_solver == 2) then
1235# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1236 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1237# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1238 pcorr = 0._wp
1239# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1240
1241# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1242 if (low_mach == 1) then
1243# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1244 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))) &
1245# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1246 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
1247# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1248 else if (low_mach == 2) then
1249# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1250 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))))
1251# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1252 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))))
1253# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1254 vel_l(dir_idx(1)) = vel_l_tmp
1255# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1256 vel_r(dir_idx(1)) = vel_r_tmp
1257# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1258 end if
1259# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1260 end if
1261 else
1262 pcorr = 0._wp
1263 end if
1264
1265 ! Mass
1266 if (.not. relativity) then
1267
1268# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1269#if defined(MFC_OpenACC)
1270# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1271!$acc loop seq
1272# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1273#elif defined(MFC_OpenMP)
1274# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1275
1276# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1277#endif
1278 do i = 1, eqn_idx%cont%end
1279 flux_rsx_vf(j, k, l, &
1280 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
1281 & + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
1282 end do
1283 else if (relativity) then
1284
1285# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1286#if defined(MFC_OpenACC)
1287# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1288!$acc loop seq
1289# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1290#elif defined(MFC_OpenMP)
1291# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1292
1293# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1294#endif
1295 do i = 1, eqn_idx%cont%end
1296 flux_rsx_vf(j, k, l, &
1297 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
1298 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i)))/(s_m &
1299 & - s_p)
1300 end do
1301 end if
1302
1303 ! Momentum
1304 if (mhd .and. (.not. relativity)) then
1305
1306# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1307#if defined(MFC_OpenACC)
1308# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1309!$acc loop seq
1310# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1311#elif defined(MFC_OpenMP)
1312# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1313
1314# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1315#endif
1316 do i = 1, 3
1317 ! Flux of rho*v_i in the x direction = rho * v_i * v_x - B_i * B_x +
1318 ! delta_(x,i) * p_tot
1319 flux_rsx_vf(j, k, l, &
1320 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
1321 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
1322 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
1323 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
1324 end do
1325 else if (mhd .and. relativity) then
1326
1327# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1328#if defined(MFC_OpenACC)
1329# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1330!$acc loop seq
1331# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1332#elif defined(MFC_OpenMP)
1333# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1334
1335# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1336#endif
1337 do i = 1, 3
1338 ! Flux of m_i in the x direction = m_i * v_x - b_i/Gamma * B_x +
1339 ! delta_(x,i) * p_tot
1340 flux_rsx_vf(j, k, l, &
1341 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
1342 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
1343 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
1344 & ) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
1345 end do
1346 else if (bubbles_euler) then
1347
1348# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1349#if defined(MFC_OpenACC)
1350# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1351!$acc loop seq
1352# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1353#elif defined(MFC_OpenMP)
1354# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1355
1356# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1357#endif
1358 do i = 1, num_vels
1359 flux_rsx_vf(j, k, l, &
1360 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1361 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
1362 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
1363 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
1364 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
1365 end do
1366 else if (hypoelasticity) then
1367
1368# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1369#if defined(MFC_OpenACC)
1370# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1371!$acc loop seq
1372# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1373#elif defined(MFC_OpenMP)
1374# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1375
1376# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1377#endif
1378 do i = 1, num_vels
1379 flux_rsx_vf(j, k, l, &
1380 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1381 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
1382 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l &
1383 & - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
1384 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
1385 end do
1386 else
1387
1388# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1389#if defined(MFC_OpenACC)
1390# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1391!$acc loop seq
1392# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1393#elif defined(MFC_OpenMP)
1394# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1395
1396# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1397#endif
1398 do i = 1, num_vels
1399 flux_rsx_vf(j, k, l, &
1400 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
1401 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
1402 & + dir_flg(dir_idx(i))*pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
1403 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
1404 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
1405 end do
1406 end if
1407
1408 ! Energy
1409 if (mhd .and. (.not. relativity)) then
1410 ! energy flux = (E + p + p_mag) * v_x - B_x * (v_x*B_x + v_y*B_y + v_z*B_z)
1411# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1412 flux_rsx_vf(j, k, l, &
1413 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
1414 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) - s_p*(vel_l(norm_dir) &
1415 & *(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) &
1416 & + vel_l(3)*b%L(3))) + s_m*s_p*(e_l - e_r))/(s_m - s_p)
1417# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1418 else if (mhd .and. relativity) then
1419 ! energy flux = m_x - mass flux Hard-coded for single-component for now
1420 flux_rsx_vf(j, k, l, &
1421 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
1422 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l - e_r)) &
1423 & /(s_m - s_p)
1424 else if (bubbles_euler) then
1425 flux_rsx_vf(j, k, l, &
1426 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) - s_p*vel_l(dir_idx(1) &
1427 & )*(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) &
1428 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
1429 else if (hypoelasticity) then
1430 flux_tau_l = 0._wp; flux_tau_r = 0._wp
1431
1432# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1433#if defined(MFC_OpenACC)
1434# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1435!$acc loop seq
1436# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1437#elif defined(MFC_OpenMP)
1438# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1439
1440# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1441#endif
1442 do i = 1, num_dims
1443 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
1444 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
1445 end do
1446 flux_rsx_vf(j, k, l, &
1447 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
1448 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r))/(s_m &
1449 & - s_p)
1450 else
1451 flux_rsx_vf(j, k, l, &
1452 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
1453 & + 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 &
1454 & - vel_l_rms)/2._wp
1455 end if
1456
1457 ! Elastic Stresses
1458 if (hypoelasticity) then
1459 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
1460 flux_rsx_vf(j, k, l, &
1461 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
1462 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
1463 & - rho_r*tau_e_r(i)))/(s_m - s_p)
1464 end do
1465 end if
1466
1467 ! Advection flux and source: interface velocity for volume fraction transport
1468
1469# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1470#if defined(MFC_OpenACC)
1471# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1472!$acc loop seq
1473# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1474#elif defined(MFC_OpenMP)
1475# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1476
1477# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1478#endif
1479 do i = eqn_idx%adv%beg, eqn_idx%adv%end
1480 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j + 1, k, l, &
1481 & i))*s_m*s_p/(s_m - s_p)
1482 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j + 1, k, l, &
1483 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
1484 end do
1485
1486 if (bubbles_euler) then
1487 ! From HLLC: Kills mass transport @ bubble gas density
1488 if (num_fluids > 1) then
1489 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
1490 end if
1491 end if
1492
1493 if (chemistry) then
1494
1495# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1496#if defined(MFC_OpenACC)
1497# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1498!$acc loop seq
1499# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1500#elif defined(MFC_OpenMP)
1501# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1502
1503# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1504#endif
1505 do i = eqn_idx%species%beg, eqn_idx%species%end
1506 y_l = ql_prim_rsx_vf(j, k, l, i)
1507 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
1508
1509 flux_rsx_vf(j, k, l, &
1510 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
1511 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
1512 flux_src_rsx_vf(j, k, l, i) = 0._wp
1513 end do
1514 end if
1515
1516 ! MHD: magnetic flux and Maxwell stress contributions
1517 if (mhd) then
1518 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
1519 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
1520
1521# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1522#if defined(MFC_OpenACC)
1523# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1524!$acc loop seq
1525# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1526#elif defined(MFC_OpenMP)
1527# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1528
1529# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1530#endif
1531 do i = 0, 1
1532 flux_rsx_vf(j, k, l, &
1533 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
1534 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
1535 & - b%R(2 + i)))/(s_m - s_p)
1536 end do
1537 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
1538 ! B_x d/dx flux = (1 - delta(x,x)) * (v_x * B_x - v_x * B_x) B_y
1539 ! d/dx flux = (1 - delta(y,x)) * (v_x * B_y - v_y * B_x) B_z d/dx
1540 ! flux = (1 - delta(z,x)) * (v_x * B_z - v_z * B_x)
1541
1542# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1543#if defined(MFC_OpenACC)
1544# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1545!$acc loop seq
1546# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1547#elif defined(MFC_OpenMP)
1548# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1549
1550# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1551#endif
1552 do i = 0, 2
1553 flux_rsx_vf(j, k, l, &
1554 & eqn_idx%B%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1) &
1555 & *b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1) &
1556 & *b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
1557 end do
1558
1559 if (hyper_cleaning) then
1560 ! propagate magnetic field divergence as a wave
1561 flux_rsx_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = flux_rsx_vf(j, k, l, &
1562 & eqn_idx%B%beg + norm_dir - 1) + (s_m*qr_prim_rsx_vf(j + 1, k, l, &
1563 & eqn_idx%psi) - s_p*ql_prim_rsx_vf(j, k, l, eqn_idx%psi))/(s_m - s_p)
1564
1565 flux_rsx_vf(j, k, l, &
1566 & eqn_idx%psi) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) &
1567 & - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsx_vf(j, k, l, &
1568 & eqn_idx%psi) - qr_prim_rsx_vf(j + 1, k, l, eqn_idx%psi)))/(s_m - s_p)
1569 else
1570 ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
1571 flux_rsx_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = 0._wp
1572 end if
1573 end if
1574 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
1575 end if
1576
1577# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1578 end do
1579 end do
1580 end do
1581
1582# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1583#if defined(MFC_OpenACC)
1584# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1585!$acc end parallel loop
1586# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1587#elif defined(MFC_OpenMP)
1588# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1589
1590# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1591!$omp end target teams loop
1592# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1593#endif
1594 end if
1595# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1596# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1597# 213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1598 if (norm_dir == 2) then
1599
1600# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1601
1602# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1603#if defined(MFC_OpenACC)
1604# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1605!$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)
1606# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1607#elif defined(MFC_OpenMP)
1608# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1609
1610# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1611
1612# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1613
1614# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1615!$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)
1616# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1617#endif
1618# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1619 do l = is3%beg, is3%end
1620 do k = is1%beg, is1%end
1621 do j = is2%beg, is2%end
1622
1623# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1624#if defined(MFC_OpenACC)
1625# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1626!$acc loop seq
1627# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1628#elif defined(MFC_OpenMP)
1629# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1630
1631# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1632#endif
1633 do i = 1, eqn_idx%cont%end
1634 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
1635 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
1636 end do
1637
1638 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1639
1640
1641# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1642#if defined(MFC_OpenACC)
1643# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1644!$acc loop seq
1645# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1646#elif defined(MFC_OpenMP)
1647# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1648
1649# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1650#endif
1651 do i = 1, num_vels
1652 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
1653 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
1654 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1655 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1656 end do
1657
1658
1659# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1660#if defined(MFC_OpenACC)
1661# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1662!$acc loop seq
1663# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1664#elif defined(MFC_OpenMP)
1665# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1666
1667# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1668#endif
1669 do i = 1, num_fluids
1670 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
1671 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
1672 end do
1673
1674 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
1675 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
1676
1677 if (mhd) then
1678 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
1679 b%L(1) = bx0
1680 b%R(1) = bx0
1681 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
1682 b%R(2) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg)
1683 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
1684 b%R(3) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + 1)
1685 else ! 2D/3D: Bx, By, Bz as variables
1686 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
1687 b%R(1) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg)
1688 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
1689 b%R(2) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + 1)
1690 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
1691 b%R(3) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + 2)
1692 end if
1693 end if
1694
1695 rho_l = 0._wp
1696 gamma_l = 0._wp
1697 pi_inf_l = 0._wp
1698 qv_l = 0._wp
1699
1700 rho_r = 0._wp
1701 gamma_r = 0._wp
1702 pi_inf_r = 0._wp
1703 qv_r = 0._wp
1704
1705 alpha_l_sum = 0._wp
1706 alpha_r_sum = 0._wp
1707
1708 pres_mag%L = 0._wp
1709 pres_mag%R = 0._wp
1710
1711 if (mpp_lim) then
1712
1713# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1714#if defined(MFC_OpenACC)
1715# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1716!$acc loop seq
1717# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1718#elif defined(MFC_OpenMP)
1719# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1720
1721# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1722#endif
1723 do i = 1, num_fluids
1724 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
1725 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
1726 alpha_l_sum = alpha_l_sum + alpha_l(i)
1727 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
1728 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
1729 alpha_r_sum = alpha_r_sum + alpha_r(i)
1730 end do
1731
1732 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
1733 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
1734 end if
1735
1736
1737# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1738#if defined(MFC_OpenACC)
1739# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1740!$acc loop seq
1741# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1742#elif defined(MFC_OpenMP)
1743# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1744
1745# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1746#endif
1747 do i = 1, num_fluids
1748 rho_l = rho_l + alpha_rho_l(i)
1749 gamma_l = gamma_l + alpha_l(i)*gammas(i)
1750 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
1751 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
1752
1753 rho_r = rho_r + alpha_rho_r(i)
1754 gamma_r = gamma_r + alpha_r(i)*gammas(i)
1755 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
1756 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
1757 end do
1758
1759 if (viscous) then
1760
1761# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1762#if defined(MFC_OpenACC)
1763# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1764!$acc loop seq
1765# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1766#elif defined(MFC_OpenMP)
1767# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1768
1769# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1770#endif
1771 do i = 1, 2
1772 re_l(i) = dflt_real
1773 re_r(i) = dflt_real
1774
1775 if (re_size(i) > 0) re_l(i) = 0._wp
1776 if (re_size(i) > 0) re_r(i) = 0._wp
1777
1778
1779# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1780#if defined(MFC_OpenACC)
1781# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1782!$acc loop seq
1783# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1784#elif defined(MFC_OpenMP)
1785# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1786
1787# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1788#endif
1789 do q = 1, re_size(i)
1790 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
1791 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
1792 end do
1793
1794 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
1795 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
1796 end do
1797 end if
1798
1799 if (chemistry) then
1800
1801# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1802#if defined(MFC_OpenACC)
1803# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1804!$acc loop seq
1805# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1806#elif defined(MFC_OpenMP)
1807# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1808
1809# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1810#endif
1811 do i = eqn_idx%species%beg, eqn_idx%species%end
1812 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
1813 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
1814 end do
1815
1816 call get_mixture_molecular_weight(ys_l, mw_l)
1817 call get_mixture_molecular_weight(ys_r, mw_r)
1818# 346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1819 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
1820 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
1821# 349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1822
1823 r_gas_l = gas_constant/mw_l
1824 r_gas_r = gas_constant/mw_r
1825 t_l = pres_l/rho_l/r_gas_l
1826 t_r = pres_r/rho_r/r_gas_r
1827
1828 call get_species_specific_heats_r(t_l, cp_il)
1829 call get_species_specific_heats_r(t_r, cp_ir)
1830
1831 if (chem_params%gamma_method == 1) then
1832 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
1833 gamma_il = cp_il/(cp_il - 1.0_wp)
1834 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
1835
1836 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
1837 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
1838 else if (chem_params%gamma_method == 2) then
1839 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
1840 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
1841 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
1842 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
1843 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
1844
1845 gamm_l = cp_l/cv_l
1846 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
1847 gamm_r = cp_r/cv_r
1848 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
1849 end if
1850
1851 call get_mixture_energy_mass(t_l, ys_l, e_l)
1852 call get_mixture_energy_mass(t_r, ys_r, e_r)
1853
1854 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
1855 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
1856 h_l = (e_l + pres_l)/rho_l
1857 h_r = (e_r + pres_r)/rho_r
1858 else if (mhd .and. relativity) then
1859 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
1860 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
1861# 389 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1862 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
1863 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
1864
1865 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
1866 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
1867 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
1868 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
1869# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1870
1871 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
1872 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
1873
1874 ! Hard-coded EOS
1875 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
1876 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
1877# 405 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1878 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
1879 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
1880# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1881
1882 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
1883 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
1884 else if (mhd .and. .not. relativity) then
1885# 413 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1886 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
1887 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
1888# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1889 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
1890 ! includes magnetic energy
1891 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R
1892 h_l = (e_l + pres_l - pres_mag%L)/rho_l
1893 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
1894 h_r = (e_r + pres_r - pres_mag%R)/rho_r
1895 else
1896 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
1897 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
1898 h_l = (e_l + pres_l)/rho_l
1899 h_r = (e_r + pres_r)/rho_r
1900 end if
1901
1902 ! elastic energy update
1903 if (hypoelasticity) then
1904 g_l = 0._wp; g_r = 0._wp
1905
1906
1907# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1908#if defined(MFC_OpenACC)
1909# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1910!$acc loop seq
1911# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1912#elif defined(MFC_OpenMP)
1913# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1914
1915# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1916#endif
1917 do i = 1, num_fluids
1918 g_l = g_l + alpha_l(i)*gs_rs(i)
1919 g_r = g_r + alpha_r(i)*gs_rs(i)
1920 end do
1921
1922 if (cont_damage) then
1923 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
1924 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
1925 end if
1926
1927
1928# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1929#if defined(MFC_OpenACC)
1930# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1931!$acc loop seq
1932# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1933#elif defined(MFC_OpenMP)
1934# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1935
1936# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1937#endif
1938 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
1939 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
1940 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
1941 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
1942 if ((g_l > 1000) .and. (g_r > 1000)) then
1943 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
1944 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
1945 ! Double for shear stresses
1946 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
1947 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
1948 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
1949 end if
1950 end if
1951 end do
1952 end if
1953
1954 if (avg_state == 1) then
1955# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1956 rho_avg = sqrt(rho_l*rho_r)
1957# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1958
1959# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1960 vel_avg_rms = 0._wp
1961# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1962
1963# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1964
1965# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1966#if defined(MFC_OpenACC)
1967# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1968!$acc loop seq
1969# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1970#elif defined(MFC_OpenMP)
1971# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1972
1973# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1974#endif
1975# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1976 do i = 1, num_vels
1977# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1978 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
1979# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1980 end do
1981# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1982
1983# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1984 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
1985# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1986
1987# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1988 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
1989# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1990
1991# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1992 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
1993# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1994
1995# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1996 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
1997# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1998
1999# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2000 if (chemistry) then
2001# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2002 eps = 0.001_wp
2003# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2004 call get_species_enthalpies_rt(t_l, h_il)
2005# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2006 call get_species_enthalpies_rt(t_r, h_ir)
2007# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2008 h_il = h_il*gas_constant/molecular_weights*t_l
2009# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2010 h_ir = h_ir*gas_constant/molecular_weights*t_r
2011# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2012 call get_species_specific_heats_r(t_l, cp_il)
2013# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2014 call get_species_specific_heats_r(t_r, cp_ir)
2015# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2016
2017# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2018 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
2019# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2020 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
2021# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2022 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
2023# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2024 if (abs(t_l - t_r) < eps) then
2025# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2026 ! Case when T_L and T_R are very close
2027# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2028 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
2029# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2030 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
2031# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2032 & - gas_constant/molecular_weights(:)))
2033# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2034 else
2035# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2036 ! Normal calculation when T_L and T_R are sufficiently different
2037# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2038 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
2039# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2040 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
2041# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2042 end if
2043# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2044 gamma_avg = cp_avg/cv_avg
2045# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2046
2047# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2048 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
2049# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2050 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
2051# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2052 end if
2053# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2054 end if
2055# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2056
2057# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2058 if (avg_state == 2) then
2059# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2060 rho_avg = 5.e-1_wp*(rho_l + rho_r)
2061# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2062 vel_avg_rms = 0._wp
2063# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2064
2065# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2066#if defined(MFC_OpenACC)
2067# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2068!$acc loop seq
2069# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2070#elif defined(MFC_OpenMP)
2071# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2072
2073# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2074#endif
2075# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2076 do i = 1, num_vels
2077# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2078 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
2079# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2080 end do
2081# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2082
2083# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2084 h_avg = 5.e-1_wp*(h_l + h_r)
2085# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2086 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
2087# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2088 qv_avg = 5.e-1_wp*(qv_l + qv_r)
2089# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2090 end if
2091
2092 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, &
2093 & qv_l)
2094
2095 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, &
2096 & qv_r)
2097
2098 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
2099 ! variables are placeholders to call the subroutine.
2100
2101 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
2102 & c_sum_yi_phi, c_avg, qv_avg)
2103
2104 if (mhd) then
2105 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
2106 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
2107 end if
2108
2109 if (viscous) then
2110 if (chemistry) then
2111 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
2112 end if
2113
2114# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2115#if defined(MFC_OpenACC)
2116# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2117!$acc loop seq
2118# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2119#elif defined(MFC_OpenMP)
2120# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2121
2122# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2123#endif
2124 do i = 1, 2
2125 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2126 end do
2127 end if
2128
2129 ! Wave speed estimates (wave_speeds=1: direct, wave_speeds=2: pressure-based)
2130 if (wave_speeds == 1) then
2131 if (mhd) then
2132 ! MHD: use fast magnetosonic speed
2133 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
2134 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
2135 else if (hypoelasticity) then
2136 ! Elastic wave speed, Rodriguez et al. JCP (2019)
2137 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))) &
2138 & /rho_l), &
2139 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
2140 & /rho_r))
2141 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))) &
2142 & /rho_r), &
2143 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
2144 & /rho_l))
2145 else if (hyperelasticity) then
2146 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l), &
2147 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
2148 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r), &
2149 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
2150 else
2151 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
2152 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
2153 end if
2154
2155 if (hyper_cleaning) then
2156 ! Dedner GLM divergence cleaning, Dedner et al. JCP (2002)
2157 s_l = min(s_l, -hyper_cleaning_speed)
2158 s_r = max(s_r, hyper_cleaning_speed)
2159 end if
2160
2161 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
2162 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
2163 & - rho_r*(s_r - vel_r(dir_idx(1))))
2164 else if (wave_speeds == 2) then
2165 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
2166
2167 pres_sr = pres_sl
2168
2169 ! Low Mach correction: Thornber et al. JCP (2008)
2170 ms_l = max(1._wp, &
2171 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
2172 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
2173 ms_r = max(1._wp, &
2174 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
2175 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
2176
2177 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2178 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2179
2180 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
2181 end if
2182
2183 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2184
2185 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, &
2186 & s_r))
2187 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, &
2188 & s_r))
2189
2190 ! 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
2191 if (low_mach == 1) then
2192 if (riemann_solver == 1 .or. riemann_solver == 5) then
2193# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2194 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2195# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2196 pcorr = 0._wp
2197# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2198
2199# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2200 if (low_mach == 1) then
2201# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2202 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2203# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2204 end if
2205# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2206 else if (riemann_solver == 2) then
2207# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2208 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2209# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2210 pcorr = 0._wp
2211# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2212
2213# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2214 if (low_mach == 1) then
2215# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2216 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))) &
2217# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2218 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
2219# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2220 else if (low_mach == 2) then
2221# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2222 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))))
2223# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2224 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))))
2225# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2226 vel_l(dir_idx(1)) = vel_l_tmp
2227# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2228 vel_r(dir_idx(1)) = vel_r_tmp
2229# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2230 end if
2231# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2232 end if
2233 else
2234 pcorr = 0._wp
2235 end if
2236
2237 ! Mass
2238 if (.not. relativity) then
2239
2240# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2241#if defined(MFC_OpenACC)
2242# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2243!$acc loop seq
2244# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2245#elif defined(MFC_OpenMP)
2246# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2247
2248# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2249#endif
2250 do i = 1, eqn_idx%cont%end
2251 flux_rsx_vf(j, k, l, &
2252 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
2253 & + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
2254 end do
2255 else if (relativity) then
2256
2257# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2258#if defined(MFC_OpenACC)
2259# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2260!$acc loop seq
2261# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2262#elif defined(MFC_OpenMP)
2263# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2264
2265# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2266#endif
2267 do i = 1, eqn_idx%cont%end
2268 flux_rsx_vf(j, k, l, &
2269 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
2270 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i)))/(s_m &
2271 & - s_p)
2272 end do
2273 end if
2274
2275 ! Momentum
2276 if (mhd .and. (.not. relativity)) then
2277
2278# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2279#if defined(MFC_OpenACC)
2280# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2281!$acc loop seq
2282# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2283#elif defined(MFC_OpenMP)
2284# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2285
2286# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2287#endif
2288 do i = 1, 3
2289 ! Flux of rho*v_i in the y direction = rho * v_i * v_y - B_i * B_y +
2290 ! delta_(y,i) * p_tot
2291 flux_rsx_vf(j, k, l, &
2292 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
2293 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
2294 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
2295 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
2296 end do
2297 else if (mhd .and. relativity) then
2298
2299# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2300#if defined(MFC_OpenACC)
2301# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2302!$acc loop seq
2303# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2304#elif defined(MFC_OpenMP)
2305# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2306
2307# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2308#endif
2309 do i = 1, 3
2310 ! Flux of m_i in the y direction = m_i * v_y - b_i/Gamma * B_y +
2311 ! delta_(y,i) * p_tot
2312 flux_rsx_vf(j, k, l, &
2313 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
2314 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
2315 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
2316 & ) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
2317 end do
2318 else if (bubbles_euler) then
2319
2320# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2321#if defined(MFC_OpenACC)
2322# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2323!$acc loop seq
2324# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2325#elif defined(MFC_OpenMP)
2326# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2327
2328# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2329#endif
2330 do i = 1, num_vels
2331 flux_rsx_vf(j, k, l, &
2332 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2333 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
2334 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
2335 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
2336 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
2337 end do
2338 else if (hypoelasticity) then
2339
2340# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2341#if defined(MFC_OpenACC)
2342# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2343!$acc loop seq
2344# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2345#elif defined(MFC_OpenMP)
2346# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2347
2348# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2349#endif
2350 do i = 1, num_vels
2351 flux_rsx_vf(j, k, l, &
2352 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2353 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
2354 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l &
2355 & - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
2356 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
2357 end do
2358 else
2359
2360# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2361#if defined(MFC_OpenACC)
2362# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2363!$acc loop seq
2364# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2365#elif defined(MFC_OpenMP)
2366# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2367
2368# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2369#endif
2370 do i = 1, num_vels
2371 flux_rsx_vf(j, k, l, &
2372 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
2373 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
2374 & + dir_flg(dir_idx(i))*pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
2375 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
2376 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
2377 end do
2378 end if
2379
2380 ! Energy
2381 if (mhd .and. (.not. relativity)) then
2382 ! energy flux = (E + p + p_mag) * v_y - B_y * (v_x*B_x + v_y*B_y + v_z*B_z)
2383# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2384 flux_rsx_vf(j, k, l, &
2385 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
2386 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) - s_p*(vel_l(norm_dir) &
2387 & *(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) &
2388 & + vel_l(3)*b%L(3))) + s_m*s_p*(e_l - e_r))/(s_m - s_p)
2389# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2390 else if (mhd .and. relativity) then
2391 ! energy flux = m_y - mass flux Hard-coded for single-component for now
2392 flux_rsx_vf(j, k, l, &
2393 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
2394 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l - e_r)) &
2395 & /(s_m - s_p)
2396 else if (bubbles_euler) then
2397 flux_rsx_vf(j, k, l, &
2398 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) - s_p*vel_l(dir_idx(1) &
2399 & )*(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) &
2400 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
2401 else if (hypoelasticity) then
2402 flux_tau_l = 0._wp; flux_tau_r = 0._wp
2403
2404# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2405#if defined(MFC_OpenACC)
2406# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2407!$acc loop seq
2408# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2409#elif defined(MFC_OpenMP)
2410# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2411
2412# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2413#endif
2414 do i = 1, num_dims
2415 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
2416 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
2417 end do
2418 flux_rsx_vf(j, k, l, &
2419 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
2420 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r))/(s_m &
2421 & - s_p)
2422 else
2423 flux_rsx_vf(j, k, l, &
2424 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
2425 & + 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 &
2426 & - vel_l_rms)/2._wp
2427 end if
2428
2429 ! Elastic Stresses
2430 if (hypoelasticity) then
2431 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
2432 flux_rsx_vf(j, k, l, &
2433 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
2434 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
2435 & - rho_r*tau_e_r(i)))/(s_m - s_p)
2436 end do
2437 end if
2438
2439 ! Advection flux and source: interface velocity for volume fraction transport
2440
2441# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2442#if defined(MFC_OpenACC)
2443# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2444!$acc loop seq
2445# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2446#elif defined(MFC_OpenMP)
2447# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2448
2449# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2450#endif
2451 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2452 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j, k + 1, l, &
2453 & i))*s_m*s_p/(s_m - s_p)
2454 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j, k + 1, l, &
2455 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
2456 end do
2457
2458 if (bubbles_euler) then
2459 ! From HLLC: Kills mass transport @ bubble gas density
2460 if (num_fluids > 1) then
2461 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
2462 end if
2463 end if
2464
2465 if (chemistry) then
2466
2467# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2468#if defined(MFC_OpenACC)
2469# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2470!$acc loop seq
2471# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2472#elif defined(MFC_OpenMP)
2473# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2474
2475# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2476#endif
2477 do i = eqn_idx%species%beg, eqn_idx%species%end
2478 y_l = ql_prim_rsx_vf(j, k, l, i)
2479 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
2480
2481 flux_rsx_vf(j, k, l, &
2482 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
2483 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
2484 flux_src_rsx_vf(j, k, l, i) = 0._wp
2485 end do
2486 end if
2487
2488 ! MHD: magnetic flux and Maxwell stress contributions
2489 if (mhd) then
2490 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
2491 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
2492
2493# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2494#if defined(MFC_OpenACC)
2495# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2496!$acc loop seq
2497# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2498#elif defined(MFC_OpenMP)
2499# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2500
2501# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2502#endif
2503 do i = 0, 1
2504 flux_rsx_vf(j, k, l, &
2505 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
2506 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
2507 & - b%R(2 + i)))/(s_m - s_p)
2508 end do
2509 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
2510 ! B_x d/dy flux = (1 - delta(x,y)) * (v_y * B_x - v_x * B_y) B_y
2511 ! d/dy flux = (1 - delta(y,y)) * (v_y * B_y - v_y * B_y) B_z d/dy
2512 ! flux = (1 - delta(z,y)) * (v_y * B_z - v_z * B_y)
2513
2514# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2515#if defined(MFC_OpenACC)
2516# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2517!$acc loop seq
2518# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2519#elif defined(MFC_OpenMP)
2520# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2521
2522# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2523#endif
2524 do i = 0, 2
2525 flux_rsx_vf(j, k, l, &
2526 & eqn_idx%B%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1) &
2527 & *b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1) &
2528 & *b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
2529 end do
2530
2531 if (hyper_cleaning) then
2532 ! propagate magnetic field divergence as a wave
2533 flux_rsx_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = flux_rsx_vf(j, k, l, &
2534 & eqn_idx%B%beg + norm_dir - 1) + (s_m*qr_prim_rsx_vf(j, k + 1, l, &
2535 & eqn_idx%psi) - s_p*ql_prim_rsx_vf(j, k, l, eqn_idx%psi))/(s_m - s_p)
2536
2537 flux_rsx_vf(j, k, l, &
2538 & eqn_idx%psi) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) &
2539 & - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsx_vf(j, k, l, &
2540 & eqn_idx%psi) - qr_prim_rsx_vf(j, k + 1, l, eqn_idx%psi)))/(s_m - s_p)
2541 else
2542 ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
2543 flux_rsx_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = 0._wp
2544 end if
2545 end if
2546 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
2547 end if
2548
2549# 751 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2550 if (cyl_coord) then
2551 ! Substituting the advective flux into the inviscid geometrical source flux
2552
2553# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2554#if defined(MFC_OpenACC)
2555# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2556!$acc loop seq
2557# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2558#elif defined(MFC_OpenMP)
2559# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2560
2561# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2562#endif
2563 do i = 1, eqn_idx%E
2564 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
2565 end do
2566 ! Recalculating the radial momentum geometric source flux
2567 flux_gsrc_rsx_vf(j, k, l, eqn_idx%cont%end + 2) = flux_rsx_vf(j, k, l, &
2568 & eqn_idx%cont%end + 2) - (s_m*pres_r - s_p*pres_l)/(s_m - s_p)
2569 ! Geometrical source of the void fraction(s) is zero
2570
2571# 761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2572#if defined(MFC_OpenACC)
2573# 761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2574!$acc loop seq
2575# 761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2576#elif defined(MFC_OpenMP)
2577# 761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2578
2579# 761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2580#endif
2581 do i = eqn_idx%adv%beg, eqn_idx%adv%end
2582 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
2583 end do
2584 end if
2585
2586 if (cyl_coord .and. hypoelasticity) then
2587 ! += tau_sigmasigma using HLL
2588 flux_gsrc_rsx_vf(j, k, l, eqn_idx%cont%end + 2) = flux_gsrc_rsx_vf(j, k, l, &
2589 & eqn_idx%cont%end + 2) + (s_m*tau_e_r(4) - s_p*tau_e_l(4))/(s_m - s_p)
2590
2591
2592# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2593#if defined(MFC_OpenACC)
2594# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2595!$acc loop seq
2596# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2597#elif defined(MFC_OpenMP)
2598# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2599
2600# 772 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2601#endif
2602 do i = eqn_idx%stress%beg, eqn_idx%stress%end
2603 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
2604 end do
2605 end if
2606# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2607 end do
2608 end do
2609 end do
2610
2611# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2612#if defined(MFC_OpenACC)
2613# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2614!$acc end parallel loop
2615# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2616#elif defined(MFC_OpenMP)
2617# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2618
2619# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2620!$omp end target teams loop
2621# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2622#endif
2623 end if
2624# 211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2625# 212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2626# 213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2627 if (norm_dir == 3) then
2628
2629# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2630
2631# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2632#if defined(MFC_OpenACC)
2633# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2634!$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)
2635# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2636#elif defined(MFC_OpenMP)
2637# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2638
2639# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2640
2641# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2642
2643# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2644!$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)
2645# 214 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2646#endif
2647# 223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2648 do l = is1%beg, is1%end
2649 do k = is2%beg, is2%end
2650 do j = is3%beg, is3%end
2651
2652# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2653#if defined(MFC_OpenACC)
2654# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2655!$acc loop seq
2656# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2657#elif defined(MFC_OpenMP)
2658# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2659
2660# 226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2661#endif
2662 do i = 1, eqn_idx%cont%end
2663 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
2664 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
2665 end do
2666
2667 vel_l_rms = 0._wp; vel_r_rms = 0._wp
2668
2669
2670# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2671#if defined(MFC_OpenACC)
2672# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2673!$acc loop seq
2674# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2675#elif defined(MFC_OpenMP)
2676# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2677
2678# 234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2679#endif
2680 do i = 1, num_vels
2681 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
2682 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
2683 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
2684 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
2685 end do
2686
2687
2688# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2689#if defined(MFC_OpenACC)
2690# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2691!$acc loop seq
2692# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2693#elif defined(MFC_OpenMP)
2694# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2695
2696# 242 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2697#endif
2698 do i = 1, num_fluids
2699 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
2700 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
2701 end do
2702
2703 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
2704 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
2705
2706 if (mhd) then
2707 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
2708 b%L(1) = bx0
2709 b%R(1) = bx0
2710 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
2711 b%R(2) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg)
2712 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
2713 b%R(3) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + 1)
2714 else ! 2D/3D: Bx, By, Bz as variables
2715 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
2716 b%R(1) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg)
2717 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
2718 b%R(2) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + 1)
2719 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
2720 b%R(3) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + 2)
2721 end if
2722 end if
2723
2724 rho_l = 0._wp
2725 gamma_l = 0._wp
2726 pi_inf_l = 0._wp
2727 qv_l = 0._wp
2728
2729 rho_r = 0._wp
2730 gamma_r = 0._wp
2731 pi_inf_r = 0._wp
2732 qv_r = 0._wp
2733
2734 alpha_l_sum = 0._wp
2735 alpha_r_sum = 0._wp
2736
2737 pres_mag%L = 0._wp
2738 pres_mag%R = 0._wp
2739
2740 if (mpp_lim) then
2741
2742# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2743#if defined(MFC_OpenACC)
2744# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2745!$acc loop seq
2746# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2747#elif defined(MFC_OpenMP)
2748# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2749
2750# 286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2751#endif
2752 do i = 1, num_fluids
2753 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
2754 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
2755 alpha_l_sum = alpha_l_sum + alpha_l(i)
2756 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
2757 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
2758 alpha_r_sum = alpha_r_sum + alpha_r(i)
2759 end do
2760
2761 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
2762 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
2763 end if
2764
2765
2766# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2767#if defined(MFC_OpenACC)
2768# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2769!$acc loop seq
2770# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2771#elif defined(MFC_OpenMP)
2772# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2773
2774# 300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2775#endif
2776 do i = 1, num_fluids
2777 rho_l = rho_l + alpha_rho_l(i)
2778 gamma_l = gamma_l + alpha_l(i)*gammas(i)
2779 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
2780 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
2781
2782 rho_r = rho_r + alpha_rho_r(i)
2783 gamma_r = gamma_r + alpha_r(i)*gammas(i)
2784 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
2785 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
2786 end do
2787
2788 if (viscous) then
2789
2790# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2791#if defined(MFC_OpenACC)
2792# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2793!$acc loop seq
2794# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2795#elif defined(MFC_OpenMP)
2796# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2797
2798# 314 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2799#endif
2800 do i = 1, 2
2801 re_l(i) = dflt_real
2802 re_r(i) = dflt_real
2803
2804 if (re_size(i) > 0) re_l(i) = 0._wp
2805 if (re_size(i) > 0) re_r(i) = 0._wp
2806
2807
2808# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2809#if defined(MFC_OpenACC)
2810# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2811!$acc loop seq
2812# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2813#elif defined(MFC_OpenMP)
2814# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2815
2816# 322 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2817#endif
2818 do q = 1, re_size(i)
2819 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
2820 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
2821 end do
2822
2823 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
2824 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
2825 end do
2826 end if
2827
2828 if (chemistry) then
2829
2830# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2831#if defined(MFC_OpenACC)
2832# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2833!$acc loop seq
2834# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2835#elif defined(MFC_OpenMP)
2836# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2837
2838# 334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2839#endif
2840 do i = eqn_idx%species%beg, eqn_idx%species%end
2841 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
2842 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
2843 end do
2844
2845 call get_mixture_molecular_weight(ys_l, mw_l)
2846 call get_mixture_molecular_weight(ys_r, mw_r)
2847# 346 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2848 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
2849 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
2850# 349 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2851
2852 r_gas_l = gas_constant/mw_l
2853 r_gas_r = gas_constant/mw_r
2854 t_l = pres_l/rho_l/r_gas_l
2855 t_r = pres_r/rho_r/r_gas_r
2856
2857 call get_species_specific_heats_r(t_l, cp_il)
2858 call get_species_specific_heats_r(t_r, cp_ir)
2859
2860 if (chem_params%gamma_method == 1) then
2861 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
2862 gamma_il = cp_il/(cp_il - 1.0_wp)
2863 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
2864
2865 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
2866 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
2867 else if (chem_params%gamma_method == 2) then
2868 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
2869 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
2870 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
2871 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
2872 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
2873
2874 gamm_l = cp_l/cv_l
2875 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
2876 gamm_r = cp_r/cv_r
2877 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
2878 end if
2879
2880 call get_mixture_energy_mass(t_l, ys_l, e_l)
2881 call get_mixture_energy_mass(t_r, ys_r, e_r)
2882
2883 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
2884 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
2885 h_l = (e_l + pres_l)/rho_l
2886 h_r = (e_r + pres_r)/rho_r
2887 else if (mhd .and. relativity) then
2888 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
2889 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
2890# 389 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2891 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
2892 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
2893
2894 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
2895 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
2896 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
2897 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
2898# 397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2899
2900 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
2901 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
2902
2903 ! Hard-coded EOS
2904 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
2905 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
2906# 405 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2907 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
2908 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
2909# 408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2910
2911 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
2912 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
2913 else if (mhd .and. .not. relativity) then
2914# 413 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2915 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
2916 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
2917# 416 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2918 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
2919 ! includes magnetic energy
2920 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R
2921 h_l = (e_l + pres_l - pres_mag%L)/rho_l
2922 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
2923 h_r = (e_r + pres_r - pres_mag%R)/rho_r
2924 else
2925 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
2926 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
2927 h_l = (e_l + pres_l)/rho_l
2928 h_r = (e_r + pres_r)/rho_r
2929 end if
2930
2931 ! elastic energy update
2932 if (hypoelasticity) then
2933 g_l = 0._wp; g_r = 0._wp
2934
2935
2936# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2937#if defined(MFC_OpenACC)
2938# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2939!$acc loop seq
2940# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2941#elif defined(MFC_OpenMP)
2942# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2943
2944# 433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2945#endif
2946 do i = 1, num_fluids
2947 g_l = g_l + alpha_l(i)*gs_rs(i)
2948 g_r = g_r + alpha_r(i)*gs_rs(i)
2949 end do
2950
2951 if (cont_damage) then
2952 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
2953 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
2954 end if
2955
2956
2957# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2958#if defined(MFC_OpenACC)
2959# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2960!$acc loop seq
2961# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2962#elif defined(MFC_OpenMP)
2963# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2964
2965# 444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2966#endif
2967 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
2968 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
2969 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
2970 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
2971 if ((g_l > 1000) .and. (g_r > 1000)) then
2972 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2973 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2974 ! Double for shear stresses
2975 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
2976 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2977 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2978 end if
2979 end if
2980 end do
2981 end if
2982
2983 if (avg_state == 1) then
2984# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2985 rho_avg = sqrt(rho_l*rho_r)
2986# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2987
2988# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2989 vel_avg_rms = 0._wp
2990# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2991
2992# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2993
2994# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2995#if defined(MFC_OpenACC)
2996# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2997!$acc loop seq
2998# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2999#elif defined(MFC_OpenMP)
3000# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3001
3002# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3003#endif
3004# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3005 do i = 1, num_vels
3006# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3007 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
3008# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3009 end do
3010# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3011
3012# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3013 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
3014# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3015
3016# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3017 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
3018# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3019
3020# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3021 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
3022# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3023
3024# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3025 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
3026# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3027
3028# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3029 if (chemistry) then
3030# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3031 eps = 0.001_wp
3032# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3033 call get_species_enthalpies_rt(t_l, h_il)
3034# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3035 call get_species_enthalpies_rt(t_r, h_ir)
3036# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3037 h_il = h_il*gas_constant/molecular_weights*t_l
3038# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3039 h_ir = h_ir*gas_constant/molecular_weights*t_r
3040# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3041 call get_species_specific_heats_r(t_l, cp_il)
3042# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3043 call get_species_specific_heats_r(t_r, cp_ir)
3044# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3045
3046# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3047 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
3048# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3049 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
3050# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3051 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
3052# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3053 if (abs(t_l - t_r) < eps) then
3054# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3055 ! Case when T_L and T_R are very close
3056# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3057 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
3058# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3059 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
3060# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3061 & - gas_constant/molecular_weights(:)))
3062# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3063 else
3064# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3065 ! Normal calculation when T_L and T_R are sufficiently different
3066# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3067 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
3068# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3069 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
3070# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3071 end if
3072# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3073 gamma_avg = cp_avg/cv_avg
3074# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3075
3076# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3077 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
3078# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3079 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
3080# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3081 end if
3082# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3083 end if
3084# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3085
3086# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3087 if (avg_state == 2) then
3088# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3089 rho_avg = 5.e-1_wp*(rho_l + rho_r)
3090# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3091 vel_avg_rms = 0._wp
3092# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3093
3094# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3095#if defined(MFC_OpenACC)
3096# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3097!$acc loop seq
3098# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3099#elif defined(MFC_OpenMP)
3100# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3101
3102# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3103#endif
3104# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3105 do i = 1, num_vels
3106# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3107 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
3108# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3109 end do
3110# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3111
3112# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3113 h_avg = 5.e-1_wp*(h_l + h_r)
3114# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3115 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
3116# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3117 qv_avg = 5.e-1_wp*(qv_l + qv_r)
3118# 461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3119 end if
3120
3121 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, &
3122 & qv_l)
3123
3124 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, &
3125 & qv_r)
3126
3127 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
3128 ! variables are placeholders to call the subroutine.
3129
3130 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
3131 & c_sum_yi_phi, c_avg, qv_avg)
3132
3133 if (mhd) then
3134 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
3135 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
3136 end if
3137
3138 if (viscous) then
3139 if (chemistry) then
3140 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
3141 end if
3142
3143# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3144#if defined(MFC_OpenACC)
3145# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3146!$acc loop seq
3147# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3148#elif defined(MFC_OpenMP)
3149# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3150
3151# 484 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3152#endif
3153 do i = 1, 2
3154 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3155 end do
3156 end if
3157
3158 ! Wave speed estimates (wave_speeds=1: direct, wave_speeds=2: pressure-based)
3159 if (wave_speeds == 1) then
3160 if (mhd) then
3161 ! MHD: use fast magnetosonic speed
3162 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
3163 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
3164 else if (hypoelasticity) then
3165 ! Elastic wave speed, Rodriguez et al. JCP (2019)
3166 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))) &
3167 & /rho_l), &
3168 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1))) &
3169 & /rho_r))
3170 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))) &
3171 & /rho_r), &
3172 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1))) &
3173 & /rho_l))
3174 else if (hyperelasticity) then
3175 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l), &
3176 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
3177 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r), &
3178 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
3179 else
3180 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3181 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3182 end if
3183
3184 if (hyper_cleaning) then
3185 ! Dedner GLM divergence cleaning, Dedner et al. JCP (2002)
3186 s_l = min(s_l, -hyper_cleaning_speed)
3187 s_r = max(s_r, hyper_cleaning_speed)
3188 end if
3189
3190 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
3191 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
3192 & - rho_r*(s_r - vel_r(dir_idx(1))))
3193 else if (wave_speeds == 2) then
3194 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
3195
3196 pres_sr = pres_sl
3197
3198 ! Low Mach correction: Thornber et al. JCP (2008)
3199 ms_l = max(1._wp, &
3200 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
3201 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
3202 ms_r = max(1._wp, &
3203 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
3204 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
3205
3206 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3207 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3208
3209 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
3210 end if
3211
3212 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3213
3214 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, &
3215 & s_r))
3216 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, &
3217 & s_r))
3218
3219 ! 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
3220 if (low_mach == 1) then
3221 if (riemann_solver == 1 .or. riemann_solver == 5) then
3222# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3223 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3224# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3225 pcorr = 0._wp
3226# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3227
3228# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3229 if (low_mach == 1) then
3230# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3231 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3232# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3233 end if
3234# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3235 else if (riemann_solver == 2) then
3236# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3237 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3238# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3239 pcorr = 0._wp
3240# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3241
3242# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3243 if (low_mach == 1) then
3244# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3245 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))) &
3246# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3247 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
3248# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3249 else if (low_mach == 2) then
3250# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3251 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))))
3252# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3253 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))))
3254# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3255 vel_l(dir_idx(1)) = vel_l_tmp
3256# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3257 vel_r(dir_idx(1)) = vel_r_tmp
3258# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3259 end if
3260# 553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3261 end if
3262 else
3263 pcorr = 0._wp
3264 end if
3265
3266 ! Mass
3267 if (.not. relativity) then
3268
3269# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3270#if defined(MFC_OpenACC)
3271# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3272!$acc loop seq
3273# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3274#elif defined(MFC_OpenMP)
3275# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3276
3277# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3278#endif
3279 do i = 1, eqn_idx%cont%end
3280 flux_rsx_vf(j, k, l, &
3281 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
3282 & + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
3283 end do
3284 else if (relativity) then
3285
3286# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3287#if defined(MFC_OpenACC)
3288# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3289!$acc loop seq
3290# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3291#elif defined(MFC_OpenMP)
3292# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3293
3294# 567 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3295#endif
3296 do i = 1, eqn_idx%cont%end
3297 flux_rsx_vf(j, k, l, &
3298 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
3299 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i)))/(s_m &
3300 & - s_p)
3301 end do
3302 end if
3303
3304 ! Momentum
3305 if (mhd .and. (.not. relativity)) then
3306
3307# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3308#if defined(MFC_OpenACC)
3309# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3310!$acc loop seq
3311# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3312#elif defined(MFC_OpenMP)
3313# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3314
3315# 578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3316#endif
3317 do i = 1, 3
3318 ! Flux of rho*v_i in the z direction = rho * v_i * v_z - B_i * B_z +
3319 ! delta_(z,i) * p_tot
3320 flux_rsx_vf(j, k, l, &
3321 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
3322 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
3323 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
3324 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
3325 end do
3326 else if (mhd .and. relativity) then
3327
3328# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3329#if defined(MFC_OpenACC)
3330# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3331!$acc loop seq
3332# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3333#elif defined(MFC_OpenMP)
3334# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3335
3336# 589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3337#endif
3338 do i = 1, 3
3339 ! Flux of m_i in the z direction = m_i * v_z - b_i/Gamma * B_z +
3340 ! delta_(z,i) * p_tot
3341 flux_rsx_vf(j, k, l, &
3342 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
3343 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
3344 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
3345 & ) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
3346 end do
3347 else if (bubbles_euler) then
3348
3349# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3350#if defined(MFC_OpenACC)
3351# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3352!$acc loop seq
3353# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3354#elif defined(MFC_OpenMP)
3355# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3356
3357# 600 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3358#endif
3359 do i = 1, num_vels
3360 flux_rsx_vf(j, k, l, &
3361 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
3362 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
3363 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
3364 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
3365 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
3366 end do
3367 else if (hypoelasticity) then
3368
3369# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3370#if defined(MFC_OpenACC)
3371# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3372!$acc loop seq
3373# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3374#elif defined(MFC_OpenMP)
3375# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3376
3377# 610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3378#endif
3379 do i = 1, num_vels
3380 flux_rsx_vf(j, k, l, &
3381 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
3382 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
3383 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l &
3384 & - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
3385 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
3386 end do
3387 else
3388
3389# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3390#if defined(MFC_OpenACC)
3391# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3392!$acc loop seq
3393# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3394#elif defined(MFC_OpenMP)
3395# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3396
3397# 620 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3398#endif
3399 do i = 1, num_vels
3400 flux_rsx_vf(j, k, l, &
3401 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
3402 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
3403 & + dir_flg(dir_idx(i))*pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
3404 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
3405 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
3406 end do
3407 end if
3408
3409 ! Energy
3410 if (mhd .and. (.not. relativity)) then
3411 ! energy flux = (E + p + p_mag) * v_z - B_z * (v_x*B_x + v_y*B_y + v_z*B_z)
3412# 635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3413 flux_rsx_vf(j, k, l, &
3414 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
3415 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) - s_p*(vel_l(norm_dir) &
3416 & *(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) &
3417 & + vel_l(3)*b%L(3))) + s_m*s_p*(e_l - e_r))/(s_m - s_p)
3418# 641 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3419 else if (mhd .and. relativity) then
3420 ! energy flux = m_z - mass flux Hard-coded for single-component for now
3421 flux_rsx_vf(j, k, l, &
3422 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
3423 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l - e_r)) &
3424 & /(s_m - s_p)
3425 else if (bubbles_euler) then
3426 flux_rsx_vf(j, k, l, &
3427 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) - s_p*vel_l(dir_idx(1) &
3428 & )*(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) &
3429 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
3430 else if (hypoelasticity) then
3431 flux_tau_l = 0._wp; flux_tau_r = 0._wp
3432
3433# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3434#if defined(MFC_OpenACC)
3435# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3436!$acc loop seq
3437# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3438#elif defined(MFC_OpenMP)
3439# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3440
3441# 654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3442#endif
3443 do i = 1, num_dims
3444 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
3445 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
3446 end do
3447 flux_rsx_vf(j, k, l, &
3448 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
3449 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r))/(s_m &
3450 & - s_p)
3451 else
3452 flux_rsx_vf(j, k, l, &
3453 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
3454 & + 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 &
3455 & - vel_l_rms)/2._wp
3456 end if
3457
3458 ! Elastic Stresses
3459 if (hypoelasticity) then
3460 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
3461 flux_rsx_vf(j, k, l, &
3462 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
3463 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
3464 & - rho_r*tau_e_r(i)))/(s_m - s_p)
3465 end do
3466 end if
3467
3468 ! Advection flux and source: interface velocity for volume fraction transport
3469
3470# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3471#if defined(MFC_OpenACC)
3472# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3473!$acc loop seq
3474# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3475#elif defined(MFC_OpenMP)
3476# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3477
3478# 681 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3479#endif
3480 do i = eqn_idx%adv%beg, eqn_idx%adv%end
3481 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j, k, l + 1, &
3482 & i))*s_m*s_p/(s_m - s_p)
3483 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j, k, l + 1, &
3484 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
3485 end do
3486
3487 if (bubbles_euler) then
3488 ! From HLLC: Kills mass transport @ bubble gas density
3489 if (num_fluids > 1) then
3490 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
3491 end if
3492 end if
3493
3494 if (chemistry) then
3495
3496# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3497#if defined(MFC_OpenACC)
3498# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3499!$acc loop seq
3500# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3501#elif defined(MFC_OpenMP)
3502# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3503
3504# 697 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3505#endif
3506 do i = eqn_idx%species%beg, eqn_idx%species%end
3507 y_l = ql_prim_rsx_vf(j, k, l, i)
3508 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
3509
3510 flux_rsx_vf(j, k, l, &
3511 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
3512 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
3513 flux_src_rsx_vf(j, k, l, i) = 0._wp
3514 end do
3515 end if
3516
3517 ! MHD: magnetic flux and Maxwell stress contributions
3518 if (mhd) then
3519 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
3520 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
3521
3522# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3523#if defined(MFC_OpenACC)
3524# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3525!$acc loop seq
3526# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3527#elif defined(MFC_OpenMP)
3528# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3529
3530# 713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3531#endif
3532 do i = 0, 1
3533 flux_rsx_vf(j, k, l, &
3534 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
3535 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
3536 & - b%R(2 + i)))/(s_m - s_p)
3537 end do
3538 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
3539 ! B_x d/dz flux = (1 - delta(x,z)) * (v_z * B_x - v_x * B_z) B_y
3540 ! d/dz flux = (1 - delta(y,z)) * (v_z * B_y - v_y * B_z) B_z d/dz
3541 ! flux = (1 - delta(z,z)) * (v_z * B_z - v_z * B_z)
3542
3543# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3544#if defined(MFC_OpenACC)
3545# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3546!$acc loop seq
3547# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3548#elif defined(MFC_OpenMP)
3549# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3550
3551# 724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3552#endif
3553 do i = 0, 2
3554 flux_rsx_vf(j, k, l, &
3555 & eqn_idx%B%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1) &
3556 & *b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1) &
3557 & *b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
3558 end do
3559
3560 if (hyper_cleaning) then
3561 ! propagate magnetic field divergence as a wave
3562 flux_rsx_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = flux_rsx_vf(j, k, l, &
3563 & eqn_idx%B%beg + norm_dir - 1) + (s_m*qr_prim_rsx_vf(j, k, l + 1, &
3564 & eqn_idx%psi) - s_p*ql_prim_rsx_vf(j, k, l, eqn_idx%psi))/(s_m - s_p)
3565
3566 flux_rsx_vf(j, k, l, &
3567 & eqn_idx%psi) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) &
3568 & - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsx_vf(j, k, l, &
3569 & eqn_idx%psi) - qr_prim_rsx_vf(j, k, l + 1, eqn_idx%psi)))/(s_m - s_p)
3570 else
3571 ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
3572 flux_rsx_vf(j, k, l, eqn_idx%B%beg + norm_dir - 1) = 0._wp
3573 end if
3574 end if
3575 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
3576 end if
3577
3578# 778 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3579 end do
3580 end do
3581 end do
3582
3583# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3584#if defined(MFC_OpenACC)
3585# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3586!$acc end parallel loop
3587# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3588#elif defined(MFC_OpenMP)
3589# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3590
3591# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3592!$omp end target teams loop
3593# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3594#endif
3595 end if
3596# 784 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3597
3598 if (viscous) then
3599 if (weno_re_flux) then
3600 call s_compute_viscous_source_flux(ql_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3601 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3602 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3603 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3604 & qr_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3605 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3606 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3607 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, &
3608 & iy, iz)
3609 else
3610 call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3611 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3612 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3613 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3614 & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3615 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3616 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
3617 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, &
3618 & iy, iz)
3619 end if
3620 end if
3621
3622 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
3623
3624 end subroutine s_hll_riemann_solver
3625
3626 !> Lax-Friedrichs (Rusanov) approximate Riemann solver
3627 subroutine s_lf_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, &
3628
3629 & 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, &
3630 & flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
3631
3632 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, qr_prim_rsx_vf
3633 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
3634 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
3635 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
3636 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
3637
3638 ! Intercell fluxes
3639 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
3640 real(wp) :: flux_tau_l, flux_tau_r
3641 integer, intent(in) :: norm_dir
3642 type(int_bounds_info), intent(in) :: ix, iy, iz
3643
3644# 840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3645 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
3646 real(wp), dimension(num_vels) :: vel_l, vel_r
3647 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
3648 real(wp), dimension(num_species) :: ys_l, ys_r
3649 real(wp), dimension(num_species) :: cp_il, cp_ir, xs_l, xs_r, gamma_il, gamma_ir
3650 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
3651 !> Averaged velocity gradient tensor `d(vel_i)/d(coord_j)`.
3652 real(wp), dimension(num_dims, num_dims) :: vel_grad_l, vel_grad_r
3653# 849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3654 real(wp) :: rho_l, rho_r
3655 real(wp) :: pres_l, pres_r
3656 real(wp) :: e_l, e_r
3657 real(wp) :: h_l, h_r
3658 real(wp) :: cp_avg, cv_avg, t_avg, eps, c_sum_yi_phi
3659 real(wp) :: t_l, t_r
3660 real(wp) :: y_l, y_r
3661 real(wp) :: mw_l, mw_r
3662 real(wp) :: r_gas_l, r_gas_r
3663 real(wp) :: cp_l, cp_r
3664 real(wp) :: cv_l, cv_r
3665 real(wp) :: gamm_l, gamm_r
3666 real(wp) :: gamma_l, gamma_r
3667 real(wp) :: pi_inf_l, pi_inf_r
3668 real(wp) :: qv_l, qv_r
3669 real(wp) :: c_l, c_r
3670 real(wp), dimension(6) :: tau_e_l, tau_e_r
3671 real(wp) :: g_l, g_r
3672 real(wp), dimension(2) :: re_l, re_r
3673 real(wp), dimension(3) :: xi_field_l, xi_field_r
3674 real(wp) :: rho_avg
3675 real(wp) :: h_avg
3676 real(wp) :: gamma_avg
3677 real(wp) :: c_avg
3678 real(wp) :: s_l, s_r, s_m, s_p, s_s
3679 real(wp) :: xi_m, xi_p
3680 real(wp) :: ptilde_l, ptilde_r
3681 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
3682 real(wp) :: vel_l_tmp, vel_r_tmp
3683 real(wp) :: ms_l, ms_r, pres_sl, pres_sr
3684 real(wp) :: alpha_l_sum, alpha_r_sum
3685 real(wp) :: zcoef, pcorr !< low Mach number correction
3686 type(riemann_states) :: c_fast, pres_mag
3687 type(riemann_states_vec3) :: b
3688 type(riemann_states) :: ga !< Gamma (Lorentz factor)
3689 type(riemann_states) :: vdotb, b2
3690 type(riemann_states_vec3) :: b4 !< 4-magnetic field components (spatial: b4x, b4y, b4z)
3691 type(riemann_states_vec3) :: cm !< Conservative momentum variables
3692 integer :: i, j, k, l, q !< Generic loop iterators
3693 integer, dimension(3) :: idx_right_phys !< Physical (j,k,l) indices for right state.
3694 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
3695
3696 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
3697 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
3698
3699 ! Reshaping inputted data based on dimensional splitting direction
3700 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
3701# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3702# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3703# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3704 if (norm_dir == 1) then
3705
3706# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3707
3708# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3709#if defined(MFC_OpenACC)
3710# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3711!$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)
3712# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3713#elif defined(MFC_OpenMP)
3714# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3715
3716# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3717
3718# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3719
3720# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3721!$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)
3722# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3723#endif
3724# 912 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3725 do l = is3%beg, is3%end
3726 do k = is2%beg, is2%end
3727 do j = is1%beg, is1%end
3728
3729# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3730#if defined(MFC_OpenACC)
3731# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3732!$acc loop seq
3733# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3734#elif defined(MFC_OpenMP)
3735# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3736
3737# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3738#endif
3739 do i = 1, eqn_idx%cont%end
3740 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
3741 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
3742 end do
3743
3744 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3745
3746
3747# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3748#if defined(MFC_OpenACC)
3749# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3750!$acc loop seq
3751# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3752#elif defined(MFC_OpenMP)
3753# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3754
3755# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3756#endif
3757 do i = 1, num_vels
3758 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
3759 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
3760 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3761 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3762 end do
3763
3764
3765# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3766#if defined(MFC_OpenACC)
3767# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3768!$acc loop seq
3769# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3770#elif defined(MFC_OpenMP)
3771# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3772
3773# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3774#endif
3775 do i = 1, num_fluids
3776 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
3777 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
3778 end do
3779
3780 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
3781 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
3782
3783 if (mhd) then
3784 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
3785 b%L(1) = bx0
3786 b%R(1) = bx0
3787 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
3788 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg)
3789 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
3790 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 1)
3791 else ! 2D/3D: Bx, By, Bz as variables
3792 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
3793 b%R(1) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg)
3794 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
3795 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 1)
3796 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
3797 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + 2)
3798 end if
3799 end if
3800
3801 rho_l = 0._wp
3802 gamma_l = 0._wp
3803 pi_inf_l = 0._wp
3804 qv_l = 0._wp
3805
3806 rho_r = 0._wp
3807 gamma_r = 0._wp
3808 pi_inf_r = 0._wp
3809 qv_r = 0._wp
3810
3811 alpha_l_sum = 0._wp
3812 alpha_r_sum = 0._wp
3813
3814 pres_mag%L = 0._wp
3815 pres_mag%R = 0._wp
3816
3817 if (mpp_lim) then
3818
3819# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3820#if defined(MFC_OpenACC)
3821# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3822!$acc loop seq
3823# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3824#elif defined(MFC_OpenMP)
3825# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3826
3827# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3828#endif
3829 do i = 1, num_fluids
3830 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
3831 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
3832 alpha_l_sum = alpha_l_sum + alpha_l(i)
3833 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
3834 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
3835 alpha_r_sum = alpha_r_sum + alpha_r(i)
3836 end do
3837
3838 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
3839 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
3840 end if
3841
3842
3843# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3844#if defined(MFC_OpenACC)
3845# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3846!$acc loop seq
3847# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3848#elif defined(MFC_OpenMP)
3849# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3850
3851# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3852#endif
3853 do i = 1, num_fluids
3854 rho_l = rho_l + alpha_rho_l(i)
3855 gamma_l = gamma_l + alpha_l(i)*gammas(i)
3856 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
3857 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
3858
3859 rho_r = rho_r + alpha_rho_r(i)
3860 gamma_r = gamma_r + alpha_r(i)*gammas(i)
3861 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
3862 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
3863 end do
3864
3865 if (viscous) then
3866
3867# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3868#if defined(MFC_OpenACC)
3869# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3870!$acc loop seq
3871# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3872#elif defined(MFC_OpenMP)
3873# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3874
3875# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3876#endif
3877 do i = 1, 2
3878 re_l(i) = dflt_real
3879 re_r(i) = dflt_real
3880
3881 if (re_size(i) > 0) re_l(i) = 0._wp
3882 if (re_size(i) > 0) re_r(i) = 0._wp
3883
3884
3885# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3886#if defined(MFC_OpenACC)
3887# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3888!$acc loop seq
3889# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3890#elif defined(MFC_OpenMP)
3891# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3892
3893# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3894#endif
3895 do q = 1, re_size(i)
3896 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
3897 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
3898 end do
3899
3900 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
3901 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
3902 end do
3903 end if
3904
3905 if (chemistry) then
3906
3907# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3908#if defined(MFC_OpenACC)
3909# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3910!$acc loop seq
3911# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3912#elif defined(MFC_OpenMP)
3913# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3914
3915# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3916#endif
3917 do i = eqn_idx%species%beg, eqn_idx%species%end
3918 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
3919 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
3920 end do
3921
3922 call get_mixture_molecular_weight(ys_l, mw_l)
3923 call get_mixture_molecular_weight(ys_r, mw_r)
3924
3925# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3926 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
3927 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
3928# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3929
3930 r_gas_l = gas_constant/mw_l
3931 r_gas_r = gas_constant/mw_r
3932 t_l = pres_l/rho_l/r_gas_l
3933 t_r = pres_r/rho_r/r_gas_r
3934
3935 call get_species_specific_heats_r(t_l, cp_il)
3936 call get_species_specific_heats_r(t_r, cp_ir)
3937
3938 if (chem_params%gamma_method == 1) then
3939 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
3940 gamma_il = cp_il/(cp_il - 1.0_wp)
3941 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
3942
3943 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
3944 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
3945 else if (chem_params%gamma_method == 2) then
3946 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
3947 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
3948 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
3949 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
3950 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
3951
3952 gamm_l = cp_l/cv_l
3953 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
3954 gamm_r = cp_r/cv_r
3955 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
3956 end if
3957
3958 call get_mixture_energy_mass(t_l, ys_l, e_l)
3959 call get_mixture_energy_mass(t_r, ys_r, e_r)
3960
3961 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
3962 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
3963 h_l = (e_l + pres_l)/rho_l
3964 h_r = (e_r + pres_r)/rho_r
3965 else if (mhd .and. relativity) then
3966# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3967 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
3968 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
3969 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
3970 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
3971
3972 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
3973 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
3974 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
3975 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
3976
3977 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
3978 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
3979
3980 ! Hard-coded EOS
3981 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
3982 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
3983
3984 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
3985 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
3986
3987 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
3988 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
3989# 1100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3990 else if (mhd .and. .not. relativity) then
3991 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
3992 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
3993 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
3994 ! includes magnetic energy
3995 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R
3996 h_l = (e_l + pres_l - pres_mag%L)/rho_l
3997 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
3998 h_r = (e_r + pres_r - pres_mag%R)/rho_r
3999 else
4000 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
4001 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
4002 h_l = (e_l + pres_l)/rho_l
4003 h_r = (e_r + pres_r)/rho_r
4004 end if
4005
4006 ! elastic energy update
4007 if (hypoelasticity) then
4008 g_l = 0._wp; g_r = 0._wp
4009
4010
4011# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4012#if defined(MFC_OpenACC)
4013# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4014!$acc loop seq
4015# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4016#elif defined(MFC_OpenMP)
4017# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4018
4019# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4020#endif
4021 do i = 1, num_fluids
4022 g_l = g_l + alpha_l(i)*gs_rs(i)
4023 g_r = g_r + alpha_r(i)*gs_rs(i)
4024 end do
4025
4026 if (cont_damage) then
4027 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
4028 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
4029 end if
4030
4031 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4032 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
4033 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
4034 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
4035 if ((g_l > 1000) .and. (g_r > 1000)) then
4036 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4037 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4038 ! Double for shear stresses
4039 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
4040 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4041 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4042 end if
4043 end if
4044 end do
4045 end if
4046
4047 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, &
4048 & qv_l)
4049
4050 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, &
4051 & qv_r)
4052
4053 if (mhd) then
4054 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
4055 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
4056 end if
4057
4058 s_l = 0._wp; s_r = 0._wp
4059
4060
4061# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4062#if defined(MFC_OpenACC)
4063# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4064!$acc loop seq
4065# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4066#elif defined(MFC_OpenMP)
4067# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4068
4069# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4070#endif
4071 do i = 1, num_dims
4072 s_l = s_l + vel_l(i)**2._wp
4073 s_r = s_r + vel_r(i)**2._wp
4074 end do
4075
4076 s_l = sqrt(s_l)
4077 s_r = sqrt(s_r)
4078
4079 s_p = max(s_l, s_r) + max(c_l, c_r)
4080 s_m = -s_p
4081
4082 s_l = s_m
4083 s_r = s_p
4084
4085 ! Low Mach correction
4086 if (low_mach == 1) then
4087 if (riemann_solver == 1 .or. riemann_solver == 5) then
4088# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4089 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4090# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4091 pcorr = 0._wp
4092# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4093
4094# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4095 if (low_mach == 1) then
4096# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4097 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4098# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4099 end if
4100# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4101 else if (riemann_solver == 2) then
4102# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4103 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4104# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4105 pcorr = 0._wp
4106# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4107
4108# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4109 if (low_mach == 1) then
4110# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4111 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))) &
4112# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4113 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
4114# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4115 else if (low_mach == 2) then
4116# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4117 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))))
4118# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4119 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))))
4120# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4121 vel_l(dir_idx(1)) = vel_l_tmp
4122# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4123 vel_r(dir_idx(1)) = vel_r_tmp
4124# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4125 end if
4126# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4127 end if
4128 else
4129 pcorr = 0._wp
4130 end if
4131
4132 ! Mass
4133 if (.not. relativity) then
4134
4135# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4136#if defined(MFC_OpenACC)
4137# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4138!$acc loop seq
4139# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4140#elif defined(MFC_OpenMP)
4141# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4142
4143# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4144#endif
4145 do i = 1, eqn_idx%cont%end
4146 flux_rsx_vf(j, k, l, &
4147 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
4148 & + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
4149 end do
4150 else if (relativity) then
4151
4152# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4153#if defined(MFC_OpenACC)
4154# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4155!$acc loop seq
4156# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4157#elif defined(MFC_OpenMP)
4158# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4159
4160# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4161#endif
4162 do i = 1, eqn_idx%cont%end
4163 flux_rsx_vf(j, k, l, &
4164 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
4165 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i)))/(s_m &
4166 & - s_p)
4167 end do
4168 end if
4169
4170 ! Momentum
4171 if (mhd .and. (.not. relativity)) then
4172
4173# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4174#if defined(MFC_OpenACC)
4175# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4176!$acc loop seq
4177# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4178#elif defined(MFC_OpenMP)
4179# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4180
4181# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4182#endif
4183 do i = 1, 3
4184 ! Flux of rho*v_i in the x direction = rho * v_i * v_x - B_i * B_x +
4185 ! delta_(x,i) * p_tot
4186 flux_rsx_vf(j, k, l, &
4187 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
4188 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
4189 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
4190 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
4191 end do
4192 else if (mhd .and. relativity) then
4193
4194# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4195#if defined(MFC_OpenACC)
4196# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4197!$acc loop seq
4198# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4199#elif defined(MFC_OpenMP)
4200# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4201
4202# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4203#endif
4204 do i = 1, 3
4205 ! Flux of m_i in the x direction = m_i * v_x - b_i/Gamma * B_x +
4206 ! delta_(x,i) * p_tot
4207 flux_rsx_vf(j, k, l, &
4208 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
4209 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
4210 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
4211 & ) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
4212 end do
4213 else if (bubbles_euler) then
4214
4215# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4216#if defined(MFC_OpenACC)
4217# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4218!$acc loop seq
4219# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4220#elif defined(MFC_OpenMP)
4221# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4222
4223# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4224#endif
4225 do i = 1, num_vels
4226 flux_rsx_vf(j, k, l, &
4227 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4228 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
4229 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
4230 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
4231 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4232 end do
4233 else if (hypoelasticity) then
4234
4235# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4236#if defined(MFC_OpenACC)
4237# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4238!$acc loop seq
4239# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4240#elif defined(MFC_OpenMP)
4241# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4242
4243# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4244#endif
4245 do i = 1, num_vels
4246 flux_rsx_vf(j, k, l, &
4247 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4248 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
4249 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l &
4250 & - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4251 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
4252 end do
4253 else
4254
4255# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4256#if defined(MFC_OpenACC)
4257# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4258!$acc loop seq
4259# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4260#elif defined(MFC_OpenMP)
4261# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4262
4263# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4264#endif
4265 do i = 1, num_vels
4266 flux_rsx_vf(j, k, l, &
4267 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4268 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
4269 & + dir_flg(dir_idx(i))*pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4270 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
4271 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4272 end do
4273 end if
4274
4275 ! Energy
4276 if (mhd .and. (.not. relativity)) then
4277 ! energy flux = (E + p + p_mag) * v_x - B_x * (v_x*B_x + v_y*B_y + v_z*B_z)
4278# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4279 flux_rsx_vf(j, k, l, &
4280 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
4281 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) - s_p*(vel_l(norm_dir) &
4282 & *(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) &
4283 & + vel_l(3)*b%L(3))) + s_m*s_p*(e_l - e_r))/(s_m - s_p)
4284# 1265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4285 else if (mhd .and. relativity) then
4286 ! energy flux = m_x - mass flux Hard-coded for single-component for now
4287 flux_rsx_vf(j, k, l, &
4288 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
4289 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l - e_r)) &
4290 & /(s_m - s_p)
4291 else if (bubbles_euler) then
4292 flux_rsx_vf(j, k, l, &
4293 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) - s_p*vel_l(dir_idx(1) &
4294 & )*(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) &
4295 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
4296 else if (hypoelasticity) then
4297 flux_tau_l = 0._wp; flux_tau_r = 0._wp
4298
4299# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4300#if defined(MFC_OpenACC)
4301# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4302!$acc loop seq
4303# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4304#elif defined(MFC_OpenMP)
4305# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4306
4307# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4308#endif
4309 do i = 1, num_dims
4310 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
4311 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
4312 end do
4313 flux_rsx_vf(j, k, l, &
4314 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
4315 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r))/(s_m &
4316 & - s_p)
4317 else
4318 flux_rsx_vf(j, k, l, &
4319 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
4320 & + 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 &
4321 & - vel_l_rms)/2._wp
4322 end if
4323
4324 ! Elastic Stresses
4325 if (hypoelasticity) then
4326 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
4327 flux_rsx_vf(j, k, l, &
4328 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
4329 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
4330 & - rho_r*tau_e_r(i)))/(s_m - s_p)
4331 end do
4332 end if
4333
4334 ! Advection flux and source: interface velocity for volume fraction transport
4335
4336# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4337#if defined(MFC_OpenACC)
4338# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4339!$acc loop seq
4340# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4341#elif defined(MFC_OpenMP)
4342# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4343
4344# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4345#endif
4346 do i = eqn_idx%adv%beg, eqn_idx%adv%end
4347 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j + 1, k, l, &
4348 & i))*s_m*s_p/(s_m - s_p)
4349 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j + 1, k, l, &
4350 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
4351 end do
4352
4353 if (bubbles_euler) then
4354 ! From HLLC: Kills mass transport @ bubble gas density
4355 if (num_fluids > 1) then
4356 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
4357 end if
4358 end if
4359
4360 if (chemistry) then
4361
4362# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4363#if defined(MFC_OpenACC)
4364# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4365!$acc loop seq
4366# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4367#elif defined(MFC_OpenMP)
4368# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4369
4370# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4371#endif
4372 do i = eqn_idx%species%beg, eqn_idx%species%end
4373 y_l = ql_prim_rsx_vf(j, k, l, i)
4374 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
4375
4376 flux_rsx_vf(j, k, l, &
4377 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
4378 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
4379 flux_src_rsx_vf(j, k, l, i) = 0._wp
4380 end do
4381 end if
4382
4383 ! MHD: magnetic flux and Maxwell stress contributions
4384 if (mhd) then
4385 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
4386 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
4387
4388# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4389#if defined(MFC_OpenACC)
4390# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4391!$acc loop seq
4392# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4393#elif defined(MFC_OpenMP)
4394# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4395
4396# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4397#endif
4398 do i = 0, 1
4399 flux_rsx_vf(j, k, l, &
4400 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
4401 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
4402 & - b%R(2 + i)))/(s_m - s_p)
4403 end do
4404 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
4405 ! B_x d/dx flux = (1 - delta(x,x)) * (v_x * B_x - v_x * B_x) B_y
4406 ! d/dx flux = (1 - delta(y,x)) * (v_x * B_y - v_y * B_x) B_z d/dx
4407 ! flux = (1 - delta(z,x)) * (v_x * B_z - v_z * B_x)
4408
4409# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4410#if defined(MFC_OpenACC)
4411# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4412!$acc loop seq
4413# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4414#elif defined(MFC_OpenMP)
4415# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4416
4417# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4418#endif
4419 do i = 0, 2
4420 flux_rsx_vf(j, k, l, &
4421 & eqn_idx%B%beg + i) = (1 - dir_flg(i + 1))*(s_m*(vel_r(dir_idx(1))*b%R(i + 1) &
4422 & - vel_r(i + 1)*b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i &
4423 & + 1)*b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
4424 end do
4425 end if
4426 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
4427 end if
4428
4429# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4430 end do
4431 end do
4432 end do
4433
4434# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4435#if defined(MFC_OpenACC)
4436# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4437!$acc end parallel loop
4438# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4439#elif defined(MFC_OpenMP)
4440# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4441
4442# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4443!$omp end target teams loop
4444# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4445#endif
4446 end if
4447# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4448# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4449# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4450 if (norm_dir == 2) then
4451
4452# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4453
4454# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4455#if defined(MFC_OpenACC)
4456# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4457!$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)
4458# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4459#elif defined(MFC_OpenMP)
4460# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4461
4462# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4463
4464# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4465
4466# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4467!$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)
4468# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4469#endif
4470# 912 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4471 do l = is3%beg, is3%end
4472 do k = is1%beg, is1%end
4473 do j = is2%beg, is2%end
4474
4475# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4476#if defined(MFC_OpenACC)
4477# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4478!$acc loop seq
4479# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4480#elif defined(MFC_OpenMP)
4481# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4482
4483# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4484#endif
4485 do i = 1, eqn_idx%cont%end
4486 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
4487 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
4488 end do
4489
4490 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4491
4492
4493# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4494#if defined(MFC_OpenACC)
4495# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4496!$acc loop seq
4497# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4498#elif defined(MFC_OpenMP)
4499# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4500
4501# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4502#endif
4503 do i = 1, num_vels
4504 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
4505 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
4506 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4507 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4508 end do
4509
4510
4511# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4512#if defined(MFC_OpenACC)
4513# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4514!$acc loop seq
4515# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4516#elif defined(MFC_OpenMP)
4517# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4518
4519# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4520#endif
4521 do i = 1, num_fluids
4522 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
4523 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
4524 end do
4525
4526 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
4527 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
4528
4529 if (mhd) then
4530 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
4531 b%L(1) = bx0
4532 b%R(1) = bx0
4533 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
4534 b%R(2) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg)
4535 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
4536 b%R(3) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + 1)
4537 else ! 2D/3D: Bx, By, Bz as variables
4538 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
4539 b%R(1) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg)
4540 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
4541 b%R(2) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + 1)
4542 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
4543 b%R(3) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + 2)
4544 end if
4545 end if
4546
4547 rho_l = 0._wp
4548 gamma_l = 0._wp
4549 pi_inf_l = 0._wp
4550 qv_l = 0._wp
4551
4552 rho_r = 0._wp
4553 gamma_r = 0._wp
4554 pi_inf_r = 0._wp
4555 qv_r = 0._wp
4556
4557 alpha_l_sum = 0._wp
4558 alpha_r_sum = 0._wp
4559
4560 pres_mag%L = 0._wp
4561 pres_mag%R = 0._wp
4562
4563 if (mpp_lim) then
4564
4565# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4566#if defined(MFC_OpenACC)
4567# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4568!$acc loop seq
4569# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4570#elif defined(MFC_OpenMP)
4571# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4572
4573# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4574#endif
4575 do i = 1, num_fluids
4576 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
4577 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
4578 alpha_l_sum = alpha_l_sum + alpha_l(i)
4579 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
4580 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
4581 alpha_r_sum = alpha_r_sum + alpha_r(i)
4582 end do
4583
4584 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
4585 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
4586 end if
4587
4588
4589# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4590#if defined(MFC_OpenACC)
4591# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4592!$acc loop seq
4593# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4594#elif defined(MFC_OpenMP)
4595# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4596
4597# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4598#endif
4599 do i = 1, num_fluids
4600 rho_l = rho_l + alpha_rho_l(i)
4601 gamma_l = gamma_l + alpha_l(i)*gammas(i)
4602 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
4603 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
4604
4605 rho_r = rho_r + alpha_rho_r(i)
4606 gamma_r = gamma_r + alpha_r(i)*gammas(i)
4607 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
4608 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
4609 end do
4610
4611 if (viscous) then
4612
4613# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4614#if defined(MFC_OpenACC)
4615# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4616!$acc loop seq
4617# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4618#elif defined(MFC_OpenMP)
4619# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4620
4621# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4622#endif
4623 do i = 1, 2
4624 re_l(i) = dflt_real
4625 re_r(i) = dflt_real
4626
4627 if (re_size(i) > 0) re_l(i) = 0._wp
4628 if (re_size(i) > 0) re_r(i) = 0._wp
4629
4630
4631# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4632#if defined(MFC_OpenACC)
4633# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4634!$acc loop seq
4635# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4636#elif defined(MFC_OpenMP)
4637# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4638
4639# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4640#endif
4641 do q = 1, re_size(i)
4642 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
4643 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
4644 end do
4645
4646 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
4647 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
4648 end do
4649 end if
4650
4651 if (chemistry) then
4652
4653# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4654#if defined(MFC_OpenACC)
4655# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4656!$acc loop seq
4657# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4658#elif defined(MFC_OpenMP)
4659# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4660
4661# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4662#endif
4663 do i = eqn_idx%species%beg, eqn_idx%species%end
4664 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
4665 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
4666 end do
4667
4668 call get_mixture_molecular_weight(ys_l, mw_l)
4669 call get_mixture_molecular_weight(ys_r, mw_r)
4670
4671# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4672 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
4673 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
4674# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4675
4676 r_gas_l = gas_constant/mw_l
4677 r_gas_r = gas_constant/mw_r
4678 t_l = pres_l/rho_l/r_gas_l
4679 t_r = pres_r/rho_r/r_gas_r
4680
4681 call get_species_specific_heats_r(t_l, cp_il)
4682 call get_species_specific_heats_r(t_r, cp_ir)
4683
4684 if (chem_params%gamma_method == 1) then
4685 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
4686 gamma_il = cp_il/(cp_il - 1.0_wp)
4687 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
4688
4689 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
4690 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
4691 else if (chem_params%gamma_method == 2) then
4692 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
4693 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
4694 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
4695 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
4696 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
4697
4698 gamm_l = cp_l/cv_l
4699 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
4700 gamm_r = cp_r/cv_r
4701 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
4702 end if
4703
4704 call get_mixture_energy_mass(t_l, ys_l, e_l)
4705 call get_mixture_energy_mass(t_r, ys_r, e_r)
4706
4707 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
4708 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
4709 h_l = (e_l + pres_l)/rho_l
4710 h_r = (e_r + pres_r)/rho_r
4711 else if (mhd .and. relativity) then
4712# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4713 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
4714 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
4715 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
4716 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
4717
4718 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
4719 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
4720 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
4721 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
4722
4723 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
4724 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
4725
4726 ! Hard-coded EOS
4727 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
4728 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
4729
4730 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
4731 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
4732
4733 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
4734 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
4735# 1100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4736 else if (mhd .and. .not. relativity) then
4737 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
4738 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
4739 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
4740 ! includes magnetic energy
4741 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R
4742 h_l = (e_l + pres_l - pres_mag%L)/rho_l
4743 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
4744 h_r = (e_r + pres_r - pres_mag%R)/rho_r
4745 else
4746 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
4747 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
4748 h_l = (e_l + pres_l)/rho_l
4749 h_r = (e_r + pres_r)/rho_r
4750 end if
4751
4752 ! elastic energy update
4753 if (hypoelasticity) then
4754 g_l = 0._wp; g_r = 0._wp
4755
4756
4757# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4758#if defined(MFC_OpenACC)
4759# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4760!$acc loop seq
4761# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4762#elif defined(MFC_OpenMP)
4763# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4764
4765# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4766#endif
4767 do i = 1, num_fluids
4768 g_l = g_l + alpha_l(i)*gs_rs(i)
4769 g_r = g_r + alpha_r(i)*gs_rs(i)
4770 end do
4771
4772 if (cont_damage) then
4773 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
4774 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
4775 end if
4776
4777 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
4778 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
4779 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
4780 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
4781 if ((g_l > 1000) .and. (g_r > 1000)) then
4782 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4783 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4784 ! Double for shear stresses
4785 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
4786 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4787 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4788 end if
4789 end if
4790 end do
4791 end if
4792
4793 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, &
4794 & qv_l)
4795
4796 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, &
4797 & qv_r)
4798
4799 if (mhd) then
4800 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
4801 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
4802 end if
4803
4804 s_l = 0._wp; s_r = 0._wp
4805
4806
4807# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4808#if defined(MFC_OpenACC)
4809# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4810!$acc loop seq
4811# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4812#elif defined(MFC_OpenMP)
4813# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4814
4815# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4816#endif
4817 do i = 1, num_dims
4818 s_l = s_l + vel_l(i)**2._wp
4819 s_r = s_r + vel_r(i)**2._wp
4820 end do
4821
4822 s_l = sqrt(s_l)
4823 s_r = sqrt(s_r)
4824
4825 s_p = max(s_l, s_r) + max(c_l, c_r)
4826 s_m = -s_p
4827
4828 s_l = s_m
4829 s_r = s_p
4830
4831 ! Low Mach correction
4832 if (low_mach == 1) then
4833 if (riemann_solver == 1 .or. riemann_solver == 5) then
4834# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4835 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4836# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4837 pcorr = 0._wp
4838# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4839
4840# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4841 if (low_mach == 1) then
4842# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4843 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4844# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4845 end if
4846# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4847 else if (riemann_solver == 2) then
4848# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4849 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4850# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4851 pcorr = 0._wp
4852# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4853
4854# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4855 if (low_mach == 1) then
4856# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4857 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))) &
4858# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4859 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
4860# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4861 else if (low_mach == 2) then
4862# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4863 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))))
4864# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4865 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))))
4866# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4867 vel_l(dir_idx(1)) = vel_l_tmp
4868# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4869 vel_r(dir_idx(1)) = vel_r_tmp
4870# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4871 end if
4872# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4873 end if
4874 else
4875 pcorr = 0._wp
4876 end if
4877
4878 ! Mass
4879 if (.not. relativity) then
4880
4881# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4882#if defined(MFC_OpenACC)
4883# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4884!$acc loop seq
4885# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4886#elif defined(MFC_OpenMP)
4887# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4888
4889# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4890#endif
4891 do i = 1, eqn_idx%cont%end
4892 flux_rsx_vf(j, k, l, &
4893 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
4894 & + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
4895 end do
4896 else if (relativity) then
4897
4898# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4899#if defined(MFC_OpenACC)
4900# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4901!$acc loop seq
4902# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4903#elif defined(MFC_OpenMP)
4904# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4905
4906# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4907#endif
4908 do i = 1, eqn_idx%cont%end
4909 flux_rsx_vf(j, k, l, &
4910 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
4911 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i)))/(s_m &
4912 & - s_p)
4913 end do
4914 end if
4915
4916 ! Momentum
4917 if (mhd .and. (.not. relativity)) then
4918
4919# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4920#if defined(MFC_OpenACC)
4921# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4922!$acc loop seq
4923# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4924#elif defined(MFC_OpenMP)
4925# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4926
4927# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4928#endif
4929 do i = 1, 3
4930 ! Flux of rho*v_i in the y direction = rho * v_i * v_y - B_i * B_y +
4931 ! delta_(y,i) * p_tot
4932 flux_rsx_vf(j, k, l, &
4933 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
4934 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
4935 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
4936 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
4937 end do
4938 else if (mhd .and. relativity) then
4939
4940# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4941#if defined(MFC_OpenACC)
4942# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4943!$acc loop seq
4944# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4945#elif defined(MFC_OpenMP)
4946# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4947
4948# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4949#endif
4950 do i = 1, 3
4951 ! Flux of m_i in the y direction = m_i * v_y - b_i/Gamma * B_y +
4952 ! delta_(y,i) * p_tot
4953 flux_rsx_vf(j, k, l, &
4954 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
4955 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
4956 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
4957 & ) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
4958 end do
4959 else if (bubbles_euler) then
4960
4961# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4962#if defined(MFC_OpenACC)
4963# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4964!$acc loop seq
4965# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4966#elif defined(MFC_OpenMP)
4967# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4968
4969# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4970#endif
4971 do i = 1, num_vels
4972 flux_rsx_vf(j, k, l, &
4973 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4974 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
4975 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
4976 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
4977 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4978 end do
4979 else if (hypoelasticity) then
4980
4981# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4982#if defined(MFC_OpenACC)
4983# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4984!$acc loop seq
4985# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4986#elif defined(MFC_OpenMP)
4987# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4988
4989# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4990#endif
4991 do i = 1, num_vels
4992 flux_rsx_vf(j, k, l, &
4993 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
4994 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
4995 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l &
4996 & - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4997 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
4998 end do
4999 else
5000
5001# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5002#if defined(MFC_OpenACC)
5003# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5004!$acc loop seq
5005# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5006#elif defined(MFC_OpenMP)
5007# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5008
5009# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5010#endif
5011 do i = 1, num_vels
5012 flux_rsx_vf(j, k, l, &
5013 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5014 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
5015 & + dir_flg(dir_idx(i))*pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5016 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
5017 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5018 end do
5019 end if
5020
5021 ! Energy
5022 if (mhd .and. (.not. relativity)) then
5023 ! energy flux = (E + p + p_mag) * v_y - B_y * (v_x*B_x + v_y*B_y + v_z*B_z)
5024# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5025 flux_rsx_vf(j, k, l, &
5026 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
5027 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) - s_p*(vel_l(norm_dir) &
5028 & *(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) &
5029 & + vel_l(3)*b%L(3))) + s_m*s_p*(e_l - e_r))/(s_m - s_p)
5030# 1265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5031 else if (mhd .and. relativity) then
5032 ! energy flux = m_y - mass flux Hard-coded for single-component for now
5033 flux_rsx_vf(j, k, l, &
5034 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
5035 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l - e_r)) &
5036 & /(s_m - s_p)
5037 else if (bubbles_euler) then
5038 flux_rsx_vf(j, k, l, &
5039 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) - s_p*vel_l(dir_idx(1) &
5040 & )*(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) &
5041 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
5042 else if (hypoelasticity) then
5043 flux_tau_l = 0._wp; flux_tau_r = 0._wp
5044
5045# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5046#if defined(MFC_OpenACC)
5047# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5048!$acc loop seq
5049# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5050#elif defined(MFC_OpenMP)
5051# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5052
5053# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5054#endif
5055 do i = 1, num_dims
5056 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
5057 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
5058 end do
5059 flux_rsx_vf(j, k, l, &
5060 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
5061 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r))/(s_m &
5062 & - s_p)
5063 else
5064 flux_rsx_vf(j, k, l, &
5065 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
5066 & + 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 &
5067 & - vel_l_rms)/2._wp
5068 end if
5069
5070 ! Elastic Stresses
5071 if (hypoelasticity) then
5072 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
5073 flux_rsx_vf(j, k, l, &
5074 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
5075 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
5076 & - rho_r*tau_e_r(i)))/(s_m - s_p)
5077 end do
5078 end if
5079
5080 ! Advection flux and source: interface velocity for volume fraction transport
5081
5082# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5083#if defined(MFC_OpenACC)
5084# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5085!$acc loop seq
5086# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5087#elif defined(MFC_OpenMP)
5088# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5089
5090# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5091#endif
5092 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5093 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j, k + 1, l, &
5094 & i))*s_m*s_p/(s_m - s_p)
5095 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j, k + 1, l, &
5096 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
5097 end do
5098
5099 if (bubbles_euler) then
5100 ! From HLLC: Kills mass transport @ bubble gas density
5101 if (num_fluids > 1) then
5102 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
5103 end if
5104 end if
5105
5106 if (chemistry) then
5107
5108# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5109#if defined(MFC_OpenACC)
5110# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5111!$acc loop seq
5112# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5113#elif defined(MFC_OpenMP)
5114# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5115
5116# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5117#endif
5118 do i = eqn_idx%species%beg, eqn_idx%species%end
5119 y_l = ql_prim_rsx_vf(j, k, l, i)
5120 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
5121
5122 flux_rsx_vf(j, k, l, &
5123 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
5124 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
5125 flux_src_rsx_vf(j, k, l, i) = 0._wp
5126 end do
5127 end if
5128
5129 ! MHD: magnetic flux and Maxwell stress contributions
5130 if (mhd) then
5131 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
5132 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
5133
5134# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5135#if defined(MFC_OpenACC)
5136# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5137!$acc loop seq
5138# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5139#elif defined(MFC_OpenMP)
5140# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5141
5142# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5143#endif
5144 do i = 0, 1
5145 flux_rsx_vf(j, k, l, &
5146 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
5147 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
5148 & - b%R(2 + i)))/(s_m - s_p)
5149 end do
5150 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
5151 ! B_x d/dy flux = (1 - delta(x,y)) * (v_y * B_x - v_x * B_y) B_y
5152 ! d/dy flux = (1 - delta(y,y)) * (v_y * B_y - v_y * B_y) B_z d/dy
5153 ! flux = (1 - delta(z,y)) * (v_y * B_z - v_z * B_y)
5154
5155# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5156#if defined(MFC_OpenACC)
5157# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5158!$acc loop seq
5159# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5160#elif defined(MFC_OpenMP)
5161# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5162
5163# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5164#endif
5165 do i = 0, 2
5166 flux_rsx_vf(j, k, l, &
5167 & eqn_idx%B%beg + i) = (1 - dir_flg(i + 1))*(s_m*(vel_r(dir_idx(1))*b%R(i + 1) &
5168 & - vel_r(i + 1)*b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i &
5169 & + 1)*b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
5170 end do
5171 end if
5172 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
5173 end if
5174
5175# 1360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5176 if (cyl_coord) then
5177 ! Substituting the advective flux into the inviscid geometrical source flux
5178
5179# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5180#if defined(MFC_OpenACC)
5181# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5182!$acc loop seq
5183# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5184#elif defined(MFC_OpenMP)
5185# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5186
5187# 1362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5188#endif
5189 do i = 1, eqn_idx%E
5190 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
5191 end do
5192 ! Recalculating the radial momentum geometric source flux
5193 flux_gsrc_rsx_vf(j, k, l, eqn_idx%cont%end + 2) = flux_rsx_vf(j, k, l, &
5194 & eqn_idx%cont%end + 2) - (s_m*pres_r - s_p*pres_l)/(s_m - s_p)
5195 ! Geometrical source of the void fraction(s) is zero
5196
5197# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5198#if defined(MFC_OpenACC)
5199# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5200!$acc loop seq
5201# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5202#elif defined(MFC_OpenMP)
5203# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5204
5205# 1370 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5206#endif
5207 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5208 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
5209 end do
5210 end if
5211
5212 if (cyl_coord .and. hypoelasticity) then
5213 ! += tau_sigmasigma using HLL
5214 flux_gsrc_rsx_vf(j, k, l, eqn_idx%cont%end + 2) = flux_gsrc_rsx_vf(j, k, l, &
5215 & eqn_idx%cont%end + 2) + (s_m*tau_e_r(4) - s_p*tau_e_l(4))/(s_m - s_p)
5216
5217
5218# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5219#if defined(MFC_OpenACC)
5220# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5221!$acc loop seq
5222# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5223#elif defined(MFC_OpenMP)
5224# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5225
5226# 1381 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5227#endif
5228 do i = eqn_idx%stress%beg, eqn_idx%stress%end
5229 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
5230 end do
5231 end if
5232# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5233 end do
5234 end do
5235 end do
5236
5237# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5238#if defined(MFC_OpenACC)
5239# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5240!$acc end parallel loop
5241# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5242#elif defined(MFC_OpenMP)
5243# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5244
5245# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5246!$omp end target teams loop
5247# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5248#endif
5249 end if
5250# 900 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5251# 901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5252# 902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5253 if (norm_dir == 3) then
5254
5255# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5256
5257# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5258#if defined(MFC_OpenACC)
5259# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5260!$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)
5261# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5262#elif defined(MFC_OpenMP)
5263# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5264
5265# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5266
5267# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5268
5269# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5270!$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)
5271# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5272#endif
5273# 912 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5274 do l = is1%beg, is1%end
5275 do k = is2%beg, is2%end
5276 do j = is3%beg, is3%end
5277
5278# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5279#if defined(MFC_OpenACC)
5280# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5281!$acc loop seq
5282# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5283#elif defined(MFC_OpenMP)
5284# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5285
5286# 915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5287#endif
5288 do i = 1, eqn_idx%cont%end
5289 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
5290 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
5291 end do
5292
5293 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5294
5295
5296# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5297#if defined(MFC_OpenACC)
5298# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5299!$acc loop seq
5300# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5301#elif defined(MFC_OpenMP)
5302# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5303
5304# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5305#endif
5306 do i = 1, num_vels
5307 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
5308 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
5309 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5310 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5311 end do
5312
5313
5314# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5315#if defined(MFC_OpenACC)
5316# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5317!$acc loop seq
5318# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5319#elif defined(MFC_OpenMP)
5320# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5321
5322# 931 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5323#endif
5324 do i = 1, num_fluids
5325 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
5326 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
5327 end do
5328
5329 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
5330 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
5331
5332 if (mhd) then
5333 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
5334 b%L(1) = bx0
5335 b%R(1) = bx0
5336 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
5337 b%R(2) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg)
5338 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
5339 b%R(3) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + 1)
5340 else ! 2D/3D: Bx, By, Bz as variables
5341 b%L(1) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg)
5342 b%R(1) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg)
5343 b%L(2) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 1)
5344 b%R(2) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + 1)
5345 b%L(3) = ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + 2)
5346 b%R(3) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + 2)
5347 end if
5348 end if
5349
5350 rho_l = 0._wp
5351 gamma_l = 0._wp
5352 pi_inf_l = 0._wp
5353 qv_l = 0._wp
5354
5355 rho_r = 0._wp
5356 gamma_r = 0._wp
5357 pi_inf_r = 0._wp
5358 qv_r = 0._wp
5359
5360 alpha_l_sum = 0._wp
5361 alpha_r_sum = 0._wp
5362
5363 pres_mag%L = 0._wp
5364 pres_mag%R = 0._wp
5365
5366 if (mpp_lim) then
5367
5368# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5369#if defined(MFC_OpenACC)
5370# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5371!$acc loop seq
5372# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5373#elif defined(MFC_OpenMP)
5374# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5375
5376# 975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5377#endif
5378 do i = 1, num_fluids
5379 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
5380 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
5381 alpha_l_sum = alpha_l_sum + alpha_l(i)
5382 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
5383 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
5384 alpha_r_sum = alpha_r_sum + alpha_r(i)
5385 end do
5386
5387 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
5388 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
5389 end if
5390
5391
5392# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5393#if defined(MFC_OpenACC)
5394# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5395!$acc loop seq
5396# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5397#elif defined(MFC_OpenMP)
5398# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5399
5400# 989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5401#endif
5402 do i = 1, num_fluids
5403 rho_l = rho_l + alpha_rho_l(i)
5404 gamma_l = gamma_l + alpha_l(i)*gammas(i)
5405 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
5406 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
5407
5408 rho_r = rho_r + alpha_rho_r(i)
5409 gamma_r = gamma_r + alpha_r(i)*gammas(i)
5410 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
5411 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
5412 end do
5413
5414 if (viscous) then
5415
5416# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5417#if defined(MFC_OpenACC)
5418# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5419!$acc loop seq
5420# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5421#elif defined(MFC_OpenMP)
5422# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5423
5424# 1003 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5425#endif
5426 do i = 1, 2
5427 re_l(i) = dflt_real
5428 re_r(i) = dflt_real
5429
5430 if (re_size(i) > 0) re_l(i) = 0._wp
5431 if (re_size(i) > 0) re_r(i) = 0._wp
5432
5433
5434# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5435#if defined(MFC_OpenACC)
5436# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5437!$acc loop seq
5438# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5439#elif defined(MFC_OpenMP)
5440# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5441
5442# 1011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5443#endif
5444 do q = 1, re_size(i)
5445 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
5446 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
5447 end do
5448
5449 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
5450 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
5451 end do
5452 end if
5453
5454 if (chemistry) then
5455
5456# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5457#if defined(MFC_OpenACC)
5458# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5459!$acc loop seq
5460# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5461#elif defined(MFC_OpenMP)
5462# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5463
5464# 1023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5465#endif
5466 do i = eqn_idx%species%beg, eqn_idx%species%end
5467 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
5468 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
5469 end do
5470
5471 call get_mixture_molecular_weight(ys_l, mw_l)
5472 call get_mixture_molecular_weight(ys_r, mw_r)
5473
5474# 1036 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5475 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
5476 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
5477# 1039 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5478
5479 r_gas_l = gas_constant/mw_l
5480 r_gas_r = gas_constant/mw_r
5481 t_l = pres_l/rho_l/r_gas_l
5482 t_r = pres_r/rho_r/r_gas_r
5483
5484 call get_species_specific_heats_r(t_l, cp_il)
5485 call get_species_specific_heats_r(t_r, cp_ir)
5486
5487 if (chem_params%gamma_method == 1) then
5488 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
5489 gamma_il = cp_il/(cp_il - 1.0_wp)
5490 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
5491
5492 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
5493 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
5494 else if (chem_params%gamma_method == 2) then
5495 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
5496 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
5497 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
5498 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
5499 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
5500
5501 gamm_l = cp_l/cv_l
5502 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
5503 gamm_r = cp_r/cv_r
5504 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
5505 end if
5506
5507 call get_mixture_energy_mass(t_l, ys_l, e_l)
5508 call get_mixture_energy_mass(t_r, ys_r, e_r)
5509
5510 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
5511 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
5512 h_l = (e_l + pres_l)/rho_l
5513 h_r = (e_r + pres_r)/rho_r
5514 else if (mhd .and. relativity) then
5515# 1077 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5516 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
5517 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
5518 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
5519 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
5520
5521 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
5522 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
5523 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
5524 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
5525
5526 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
5527 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
5528
5529 ! Hard-coded EOS
5530 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
5531 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
5532
5533 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
5534 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
5535
5536 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
5537 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
5538# 1100 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5539 else if (mhd .and. .not. relativity) then
5540 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
5541 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
5542 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
5543 ! includes magnetic energy
5544 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R
5545 h_l = (e_l + pres_l - pres_mag%L)/rho_l
5546 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
5547 h_r = (e_r + pres_r - pres_mag%R)/rho_r
5548 else
5549 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
5550 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
5551 h_l = (e_l + pres_l)/rho_l
5552 h_r = (e_r + pres_r)/rho_r
5553 end if
5554
5555 ! elastic energy update
5556 if (hypoelasticity) then
5557 g_l = 0._wp; g_r = 0._wp
5558
5559
5560# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5561#if defined(MFC_OpenACC)
5562# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5563!$acc loop seq
5564# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5565#elif defined(MFC_OpenMP)
5566# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5567
5568# 1120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5569#endif
5570 do i = 1, num_fluids
5571 g_l = g_l + alpha_l(i)*gs_rs(i)
5572 g_r = g_r + alpha_r(i)*gs_rs(i)
5573 end do
5574
5575 if (cont_damage) then
5576 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
5577 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, eqn_idx%damage)), 0._wp)
5578 end if
5579
5580 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
5581 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
5582 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
5583 ! Elastic contribution to energy if G large enough TODO take out if statement if stable without
5584 if ((g_l > 1000) .and. (g_r > 1000)) then
5585 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5586 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5587 ! Double for shear stresses
5588 if (any(eqn_idx%stress%beg - 1 + i == shear_indices)) then
5589 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5590 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5591 end if
5592 end if
5593 end do
5594 end if
5595
5596 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, &
5597 & qv_l)
5598
5599 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, &
5600 & qv_r)
5601
5602 if (mhd) then
5603 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
5604 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
5605 end if
5606
5607 s_l = 0._wp; s_r = 0._wp
5608
5609
5610# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5611#if defined(MFC_OpenACC)
5612# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5613!$acc loop seq
5614# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5615#elif defined(MFC_OpenMP)
5616# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5617
5618# 1160 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5619#endif
5620 do i = 1, num_dims
5621 s_l = s_l + vel_l(i)**2._wp
5622 s_r = s_r + vel_r(i)**2._wp
5623 end do
5624
5625 s_l = sqrt(s_l)
5626 s_r = sqrt(s_r)
5627
5628 s_p = max(s_l, s_r) + max(c_l, c_r)
5629 s_m = -s_p
5630
5631 s_l = s_m
5632 s_r = s_p
5633
5634 ! Low Mach correction
5635 if (low_mach == 1) then
5636 if (riemann_solver == 1 .or. riemann_solver == 5) then
5637# 1177 "/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# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5640 pcorr = 0._wp
5641# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5642
5643# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5644 if (low_mach == 1) then
5645# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5646 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5647# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5648 end if
5649# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5650 else if (riemann_solver == 2) then
5651# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5652 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5653# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5654 pcorr = 0._wp
5655# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5656
5657# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5658 if (low_mach == 1) then
5659# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5660 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))) &
5661# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5662 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
5663# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5664 else if (low_mach == 2) then
5665# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5666 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))))
5667# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5668 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))))
5669# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5670 vel_l(dir_idx(1)) = vel_l_tmp
5671# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5672 vel_r(dir_idx(1)) = vel_r_tmp
5673# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5674 end if
5675# 1177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5676 end if
5677 else
5678 pcorr = 0._wp
5679 end if
5680
5681 ! Mass
5682 if (.not. relativity) then
5683
5684# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5685#if defined(MFC_OpenACC)
5686# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5687!$acc loop seq
5688# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5689#elif defined(MFC_OpenMP)
5690# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5691
5692# 1184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5693#endif
5694 do i = 1, eqn_idx%cont%end
5695 flux_rsx_vf(j, k, l, &
5696 & i) = (s_m*alpha_rho_r(i)*vel_r(norm_dir) - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
5697 & + s_m*s_p*(alpha_rho_l(i) - alpha_rho_r(i)))/(s_m - s_p)
5698 end do
5699 else if (relativity) then
5700
5701# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5702#if defined(MFC_OpenACC)
5703# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5704!$acc loop seq
5705# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5706#elif defined(MFC_OpenMP)
5707# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5708
5709# 1191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5710#endif
5711 do i = 1, eqn_idx%cont%end
5712 flux_rsx_vf(j, k, l, &
5713 & i) = (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) - s_p*ga%L*alpha_rho_l(i) &
5714 & *vel_l(norm_dir) + s_m*s_p*(ga%L*alpha_rho_l(i) - ga%R*alpha_rho_r(i)))/(s_m &
5715 & - s_p)
5716 end do
5717 end if
5718
5719 ! Momentum
5720 if (mhd .and. (.not. relativity)) then
5721
5722# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5723#if defined(MFC_OpenACC)
5724# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5725!$acc loop seq
5726# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5727#elif defined(MFC_OpenMP)
5728# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5729
5730# 1202 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5731#endif
5732 do i = 1, 3
5733 ! Flux of rho*v_i in the z direction = rho * v_i * v_z - B_i * B_z +
5734 ! delta_(z,i) * p_tot
5735 flux_rsx_vf(j, k, l, &
5736 & eqn_idx%cont%end + i) = (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) - b%R(i) &
5737 & *b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(rho_l*vel_l(i) &
5738 & *vel_l(norm_dir) - b%L(i)*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L)) &
5739 & + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i)))/(s_m - s_p)
5740 end do
5741 else if (mhd .and. relativity) then
5742
5743# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5744#if defined(MFC_OpenACC)
5745# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5746!$acc loop seq
5747# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5748#elif defined(MFC_OpenMP)
5749# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5750
5751# 1213 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5752#endif
5753 do i = 1, 3
5754 ! Flux of m_i in the z direction = m_i * v_z - b_i/Gamma * B_z +
5755 ! delta_(z,i) * p_tot
5756 flux_rsx_vf(j, k, l, &
5757 & eqn_idx%cont%end + i) = (s_m*(cm%R(i)*vel_r(norm_dir) - b4%R(i) &
5758 & /ga%R*b%R(norm_dir) + dir_flg(i)*(pres_r + pres_mag%R)) - s_p*(cm%L(i) &
5759 & *vel_l(norm_dir) - b4%L(i)/ga%L*b%L(norm_dir) + dir_flg(i)*(pres_l + pres_mag%L) &
5760 & ) + s_m*s_p*(cm%L(i) - cm%R(i)))/(s_m - s_p)
5761 end do
5762 else if (bubbles_euler) then
5763
5764# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5765#if defined(MFC_OpenACC)
5766# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5767!$acc loop seq
5768# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5769#elif defined(MFC_OpenMP)
5770# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5771
5772# 1224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5773#endif
5774 do i = 1, num_vels
5775 flux_rsx_vf(j, k, l, &
5776 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5777 & + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) - s_p*(rho_l*vel_l(dir_idx(1)) &
5778 & *vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
5779 & + s_m*s_p*(rho_l*vel_l(dir_idx(i)) - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) &
5780 & + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5781 end do
5782 else if (hypoelasticity) then
5783
5784# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5785#if defined(MFC_OpenACC)
5786# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5787!$acc loop seq
5788# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5789#elif defined(MFC_OpenMP)
5790# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5791
5792# 1234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5793#endif
5794 do i = 1, num_vels
5795 flux_rsx_vf(j, k, l, &
5796 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5797 & + dir_flg(dir_idx(i))*pres_r - tau_e_r(dir_idx_tau(i))) &
5798 & - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*pres_l &
5799 & - tau_e_l(dir_idx_tau(i))) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5800 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p)
5801 end do
5802 else
5803
5804# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5805#if defined(MFC_OpenACC)
5806# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5807!$acc loop seq
5808# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5809#elif defined(MFC_OpenMP)
5810# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5811
5812# 1244 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5813#endif
5814 do i = 1, num_vels
5815 flux_rsx_vf(j, k, l, &
5816 & eqn_idx%cont%end + dir_idx(i)) = (s_m*(rho_r*vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
5817 & + dir_flg(dir_idx(i))*pres_r) - s_p*(rho_l*vel_l(dir_idx(1))*vel_l(dir_idx(i)) &
5818 & + dir_flg(dir_idx(i))*pres_l) + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5819 & - rho_r*vel_r(dir_idx(i))))/(s_m - s_p) + (s_m/s_l)*(s_p/s_r) &
5820 & *pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5821 end do
5822 end if
5823
5824 ! Energy
5825 if (mhd .and. (.not. relativity)) then
5826 ! energy flux = (E + p + p_mag) * v_z - B_z * (v_x*B_x + v_y*B_y + v_z*B_z)
5827# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5828 flux_rsx_vf(j, k, l, &
5829 & eqn_idx%E) = (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir) &
5830 & *(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) - s_p*(vel_l(norm_dir) &
5831 & *(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) &
5832 & + vel_l(3)*b%L(3))) + s_m*s_p*(e_l - e_r))/(s_m - s_p)
5833# 1265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5834 else if (mhd .and. relativity) then
5835 ! energy flux = m_z - mass flux Hard-coded for single-component for now
5836 flux_rsx_vf(j, k, l, &
5837 & eqn_idx%E) = (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
5838 & - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) + s_m*s_p*(e_l - e_r)) &
5839 & /(s_m - s_p)
5840 else if (bubbles_euler) then
5841 flux_rsx_vf(j, k, l, &
5842 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) - s_p*vel_l(dir_idx(1) &
5843 & )*(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) &
5844 & *pcorr*(vel_r_rms - vel_l_rms)/2._wp
5845 else if (hypoelasticity) then
5846 flux_tau_l = 0._wp; flux_tau_r = 0._wp
5847
5848# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5849#if defined(MFC_OpenACC)
5850# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5851!$acc loop seq
5852# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5853#elif defined(MFC_OpenMP)
5854# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5855
5856# 1278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5857#endif
5858 do i = 1, num_dims
5859 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
5860 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
5861 end do
5862 flux_rsx_vf(j, k, l, &
5863 & eqn_idx%E) = (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
5864 & - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) + s_m*s_p*(e_l - e_r))/(s_m &
5865 & - s_p)
5866 else
5867 flux_rsx_vf(j, k, l, &
5868 & eqn_idx%E) = (s_m*vel_r(dir_idx(1))*(e_r + pres_r) - s_p*vel_l(dir_idx(1))*(e_l &
5869 & + 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 &
5870 & - vel_l_rms)/2._wp
5871 end if
5872
5873 ! Elastic Stresses
5874 if (hypoelasticity) then
5875 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1 ! TODO: this indexing may be slow
5876 flux_rsx_vf(j, k, l, &
5877 & eqn_idx%stress%beg - 1 + i) = (s_m*(rho_r*vel_r(dir_idx(1))*tau_e_r(i)) &
5878 & - s_p*(rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + s_m*s_p*(rho_l*tau_e_l(i) &
5879 & - rho_r*tau_e_r(i)))/(s_m - s_p)
5880 end do
5881 end if
5882
5883 ! Advection flux and source: interface velocity for volume fraction transport
5884
5885# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5886#if defined(MFC_OpenACC)
5887# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5888!$acc loop seq
5889# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5890#elif defined(MFC_OpenMP)
5891# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5892
5893# 1305 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5894#endif
5895 do i = eqn_idx%adv%beg, eqn_idx%adv%end
5896 flux_rsx_vf(j, k, l, i) = (ql_prim_rsx_vf(j, k, l, i) - qr_prim_rsx_vf(j, k, l + 1, &
5897 & i))*s_m*s_p/(s_m - s_p)
5898 flux_src_rsx_vf(j, k, l, i) = (s_m*qr_prim_rsx_vf(j, k, l + 1, &
5899 & i) - s_p*ql_prim_rsx_vf(j, k, l, i))/(s_m - s_p)
5900 end do
5901
5902 if (bubbles_euler) then
5903 ! From HLLC: Kills mass transport @ bubble gas density
5904 if (num_fluids > 1) then
5905 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
5906 end if
5907 end if
5908
5909 if (chemistry) then
5910
5911# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5912#if defined(MFC_OpenACC)
5913# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5914!$acc loop seq
5915# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5916#elif defined(MFC_OpenMP)
5917# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5918
5919# 1321 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5920#endif
5921 do i = eqn_idx%species%beg, eqn_idx%species%end
5922 y_l = ql_prim_rsx_vf(j, k, l, i)
5923 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
5924
5925 flux_rsx_vf(j, k, l, &
5926 & i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
5927 & + s_m*s_p*(y_l*rho_l - y_r*rho_r))/(s_m - s_p)
5928 flux_src_rsx_vf(j, k, l, i) = 0._wp
5929 end do
5930 end if
5931
5932 ! MHD: magnetic flux and Maxwell stress contributions
5933 if (mhd) then
5934 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
5935 ! B_y flux = v_x * B_y - v_y * Bx0 B_z flux = v_x * B_z - v_z * Bx0
5936
5937# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5938#if defined(MFC_OpenACC)
5939# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5940!$acc loop seq
5941# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5942#elif defined(MFC_OpenMP)
5943# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5944
5945# 1337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5946#endif
5947 do i = 0, 1
5948 flux_rsx_vf(j, k, l, &
5949 & eqn_idx%B%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
5950 & - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) + s_m*s_p*(b%L(2 + i) &
5951 & - b%R(2 + i)))/(s_m - s_p)
5952 end do
5953 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
5954 ! B_x d/dz flux = (1 - delta(x,z)) * (v_z * B_x - v_x * B_z) B_y
5955 ! d/dz flux = (1 - delta(y,z)) * (v_z * B_y - v_y * B_z) B_z d/dz
5956 ! flux = (1 - delta(z,z)) * (v_z * B_z - v_z * B_z)
5957
5958# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5959#if defined(MFC_OpenACC)
5960# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5961!$acc loop seq
5962# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5963#elif defined(MFC_OpenMP)
5964# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5965
5966# 1348 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5967#endif
5968 do i = 0, 2
5969 flux_rsx_vf(j, k, l, &
5970 & eqn_idx%B%beg + i) = (1 - dir_flg(i + 1))*(s_m*(vel_r(dir_idx(1))*b%R(i + 1) &
5971 & - vel_r(i + 1)*b%R(norm_dir)) - s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i &
5972 & + 1)*b%L(norm_dir)) + s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
5973 end do
5974 end if
5975 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
5976 end if
5977
5978# 1387 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5979 end do
5980 end do
5981 end do
5982
5983# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5984#if defined(MFC_OpenACC)
5985# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5986!$acc end parallel loop
5987# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5988#elif defined(MFC_OpenMP)
5989# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5990
5991# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5992!$omp end target teams loop
5993# 1390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5994#endif
5995 end if
5996# 1393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5997
5998 if (viscous) then
5999
6000# 1395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6001
6002# 1395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6003#if defined(MFC_OpenACC)
6004# 1395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6005!$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)
6006# 1395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6007#elif defined(MFC_OpenMP)
6008# 1395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6009
6010# 1395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6011
6012# 1395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6013
6014# 1395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6015!$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)
6016# 1395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6017#endif
6018# 1397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6019 do l = isz%beg, isz%end
6020 do k = isy%beg, isy%end
6021 do j = isx%beg, isx%end
6022 idx_right_phys(1) = j
6023 idx_right_phys(2) = k
6024 idx_right_phys(3) = l
6025 idx_right_phys(norm_dir) = idx_right_phys(norm_dir) + 1
6026
6027 if (norm_dir == 1) then
6028
6029# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6030#if defined(MFC_OpenACC)
6031# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6032!$acc loop seq
6033# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6034#elif defined(MFC_OpenMP)
6035# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6036
6037# 1406 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6038#endif
6039 do i = 1, num_fluids
6040 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6041 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
6042 end do
6043
6044
6045# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6046#if defined(MFC_OpenACC)
6047# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6048!$acc loop seq
6049# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6050#elif defined(MFC_OpenMP)
6051# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6052
6053# 1412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6054#endif
6055 do i = 1, num_dims
6056 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%mom%beg + i - 1)
6057 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%mom%beg + i - 1)
6058 end do
6059 else if (norm_dir == 2) then
6060
6061# 1418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6062#if defined(MFC_OpenACC)
6063# 1418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6064!$acc loop seq
6065# 1418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6066#elif defined(MFC_OpenMP)
6067# 1418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6068
6069# 1418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6070#endif
6071 do i = 1, num_fluids
6072 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6073 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
6074 end do
6075
6076# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6077#if defined(MFC_OpenACC)
6078# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6079!$acc loop seq
6080# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6081#elif defined(MFC_OpenMP)
6082# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6083
6084# 1423 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6085#endif
6086 do i = 1, num_dims
6087 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%mom%beg + i - 1)
6088 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%mom%beg + i - 1)
6089 end do
6090 else
6091
6092# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6093#if defined(MFC_OpenACC)
6094# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6095!$acc loop seq
6096# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6097#elif defined(MFC_OpenMP)
6098# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6099
6100# 1429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6101#endif
6102 do i = 1, num_fluids
6103 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6104 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
6105 end do
6106
6107
6108# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6109#if defined(MFC_OpenACC)
6110# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6111!$acc loop seq
6112# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6113#elif defined(MFC_OpenMP)
6114# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6115
6116# 1435 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6117#endif
6118 do i = 1, num_dims
6119 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%mom%beg + i - 1)
6120 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%mom%beg + i - 1)
6121 end do
6122 end if
6123
6124
6125# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6126#if defined(MFC_OpenACC)
6127# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6128!$acc loop seq
6129# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6130#elif defined(MFC_OpenMP)
6131# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6132
6133# 1442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6134#endif
6135 do i = 1, 2
6136 re_l(i) = dflt_real
6137 re_r(i) = dflt_real
6138
6139 if (re_size(i) > 0) re_l(i) = 0._wp
6140 if (re_size(i) > 0) re_r(i) = 0._wp
6141
6142
6143# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6144#if defined(MFC_OpenACC)
6145# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6146!$acc loop seq
6147# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6148#elif defined(MFC_OpenMP)
6149# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6150
6151# 1450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6152#endif
6153 do q = 1, re_size(i)
6154 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
6155 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
6156 end do
6157
6158 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6159 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6160 end do
6161
6162 if (shear_stress) then
6163
6164# 1461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6165#if defined(MFC_OpenACC)
6166# 1461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6167!$acc loop seq
6168# 1461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6169#elif defined(MFC_OpenMP)
6170# 1461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6171
6172# 1461 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6173#endif
6174 do i = 1, num_dims
6175 vel_grad_l(i, 1) = (dql_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(1))
6176 vel_grad_r(i, 1) = (dqr_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6177 & idx_right_phys(2), idx_right_phys(3))/re_r(1))
6178# 1467 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6179 if (num_dims > 1) then
6180 vel_grad_l(i, 2) = (dql_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(1))
6181 vel_grad_r(i, 2) = (dqr_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6182 & idx_right_phys(2), idx_right_phys(3))/re_r(1))
6183 end if
6184# 1473 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6185 if (num_dims > 2) then
6186 vel_grad_l(i, 3) = (dql_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(1))
6187 vel_grad_r(i, 3) = (dqr_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6188 & idx_right_phys(2), idx_right_phys(3))/re_r(1))
6189 end if
6190# 1479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6191# 1480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6192 end do
6193
6194 if (norm_dir == 1) then
6195 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6196 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6197 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6198 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(1) + vel_grad_r(1, 1)*vel_r(1))
6199# 1488 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6200 if (num_dims > 1) 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(2, 2) + vel_grad_r(2, 2))
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(2, 2)*vel_l(1) + vel_grad_r(2, &
6205 & 2)*vel_r(1))
6206
6207 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6208 & l) - 0.5_wp*(vel_grad_l(1, 2) + vel_grad_r(1, 2)) - 0.5_wp*(vel_grad_l(2, &
6209 & 1) + vel_grad_r(2, 1))
6210 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6211 & l) - 0.5_wp*(vel_grad_l(1, 2)*vel_l(2) + vel_grad_r(1, &
6212 & 2)*vel_r(2)) - 0.5_wp*(vel_grad_l(2, 1)*vel_l(2) + vel_grad_r(2, 1)*vel_r(2))
6213# 1502 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6214 if (num_dims > 2) then
6215 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6216 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6217 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6218 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, &
6219 & 3)*vel_l(1) + vel_grad_r(3, 3)*vel_r(1))
6220
6221 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6222 & l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6223 & l) - 0.5_wp*(vel_grad_l(1, 3) + vel_grad_r(1, &
6224 & 3)) - 0.5_wp*(vel_grad_l(3, 1) + vel_grad_r(3, 1))
6225 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6226 & l) - 0.5_wp*(vel_grad_l(1, 3)*vel_l(3) + vel_grad_r(1, &
6227 & 3)*vel_r(3)) - 0.5_wp*(vel_grad_l(3, 1)*vel_l(3) + vel_grad_r(3, &
6228 & 1)*vel_r(3))
6229 end if
6230# 1519 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6231 end if
6232# 1521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6233 else if (norm_dir == 2) then
6234# 1523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6235 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6236 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6237 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6238 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(2) + vel_grad_r(1, 1)*vel_r(2))
6239
6240 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6241 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6242 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6243 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(2) + vel_grad_r(2, 2)*vel_r(2))
6244
6245 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6246 & l) - 0.5_wp*(vel_grad_l(1, 2) + vel_grad_r(1, 2)) - 0.5_wp*(vel_grad_l(2, &
6247 & 1) + vel_grad_r(2, 1))
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(1, 2)*vel_l(1) + vel_grad_r(1, &
6250 & 2)*vel_r(1)) - 0.5_wp*(vel_grad_l(2, 1)*vel_l(1) + vel_grad_r(2, 1)*vel_r(1))
6251# 1540 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6252 if (num_dims > 2) then
6253 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, &
6254 & k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6255 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6256 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3)*vel_l(2) + vel_grad_r(3, &
6257 & 3)*vel_r(2))
6258
6259 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, &
6260 & k, l) - 0.5_wp*(vel_grad_l(2, 3) + vel_grad_r(2, &
6261 & 3)) - 0.5_wp*(vel_grad_l(3, 2) + vel_grad_r(3, 2))
6262 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6263 & l) - 0.5_wp*(vel_grad_l(2, 3)*vel_l(3) + vel_grad_r(2, &
6264 & 3)*vel_r(3)) - 0.5_wp*(vel_grad_l(3, 2)*vel_l(3) + vel_grad_r(3, &
6265 & 2)*vel_r(3))
6266 end if
6267# 1556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6268# 1557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6269 else
6270# 1559 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6271 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6272 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6273 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6274 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(3) + vel_grad_r(1, 1)*vel_r(3))
6275
6276 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6277 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6278 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6279 & l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(3) + vel_grad_r(2, 2)*vel_r(3))
6280
6281 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6282 & l) - 0.5_wp*(vel_grad_l(1, 3) + vel_grad_r(1, 3)) - 0.5_wp*(vel_grad_l(3, &
6283 & 1) + vel_grad_r(3, 1))
6284 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6285 & l) - 0.5_wp*(vel_grad_l(1, 3)*vel_l(1) + vel_grad_r(1, &
6286 & 3)*vel_r(1)) - 0.5_wp*(vel_grad_l(3, 1)*vel_l(1) + vel_grad_r(3, 1)*vel_r(1))
6287
6288 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6289 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6290 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6291 & l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3)*vel_l(3) + vel_grad_r(3, 3)*vel_r(3))
6292
6293 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6294 & l) - 0.5_wp*(vel_grad_l(2, 3) + vel_grad_r(2, 3)) - 0.5_wp*(vel_grad_l(3, &
6295 & 2) + vel_grad_r(3, 2))
6296 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6297 & l) - 0.5_wp*(vel_grad_l(2, 3)*vel_l(2) + vel_grad_r(2, &
6298 & 3)*vel_r(2)) - 0.5_wp*(vel_grad_l(3, 2)*vel_l(2) + vel_grad_r(3, 2)*vel_r(2))
6299# 1588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6300 end if
6301 end if
6302
6303 if (bulk_stress) then
6304
6305# 1592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6306#if defined(MFC_OpenACC)
6307# 1592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6308!$acc loop seq
6309# 1592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6310#elif defined(MFC_OpenMP)
6311# 1592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6312
6313# 1592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6314#endif
6315 do i = 1, num_dims
6316 vel_grad_l(i, 1) = (dql_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(2))
6317 vel_grad_r(i, 1) = (dqr_prim_dx_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6318 & idx_right_phys(2), idx_right_phys(3))/re_r(2))
6319# 1598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6320 if (num_dims > 1) then
6321 vel_grad_l(i, 2) = (dql_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(2))
6322 vel_grad_r(i, 2) = (dqr_prim_dy_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6323 & idx_right_phys(2), idx_right_phys(3))/re_r(2))
6324 end if
6325# 1604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6326# 1605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6327 if (num_dims > 2) then
6328 vel_grad_l(i, 3) = (dql_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(j, k, l)/re_l(2))
6329 vel_grad_r(i, 3) = (dqr_prim_dz_vf(eqn_idx%mom%beg + i - 1)%sf(idx_right_phys(1), &
6330 & idx_right_phys(2), idx_right_phys(3))/re_r(2))
6331 end if
6332# 1611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6333 end do
6334
6335 if (norm_dir == 1) then
6336 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6337 & l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6338 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, &
6339 & 1)*vel_l(1) + vel_grad_r(1, 1)*vel_r(1))
6340# 1619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6341 if (num_dims > 1) then
6342 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6343 & l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6344 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6345 & l) - 0.5_wp*(vel_grad_l(2, 2)*vel_l(1) + vel_grad_r(2, 2)*vel_r(1))
6346
6347# 1626 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6348 if (num_dims > 2) then
6349 flux_src_vf(eqn_idx%mom%beg)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg)%sf(j, k, &
6350 & l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6351 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6352 & l) - 0.5_wp*(vel_grad_l(3, 3)*vel_l(1) + vel_grad_r(3, 3)*vel_r(1))
6353 end if
6354# 1633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6355 end if
6356# 1635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6357 else if (norm_dir == 2) then
6358# 1637 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6359 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6360 & l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6361 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6362 & l) - 0.5_wp*(vel_grad_l(1, 1)*vel_l(2) + vel_grad_r(1, 1)*vel_r(2))
6363
6364 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, &
6365 & l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6366 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6367 & l) - 0.5_wp*(vel_grad_l(2, 2)*vel_l(2) + vel_grad_r(2, 2)*vel_r(2))
6368
6369# 1648 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6370 if (num_dims > 2) then
6371 flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 1)%sf(j, &
6372 & k, l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
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(3, 3)*vel_l(2) + vel_grad_r(3, 3)*vel_r(2))
6375 end if
6376# 1655 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6377# 1656 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6378 else
6379# 1658 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6380 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6381 & l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6382 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6383 & l) - 0.5_wp*(vel_grad_l(1, 1)*vel_l(3) + vel_grad_r(1, 1)*vel_r(3))
6384
6385 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6386 & l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6387 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6388 & l) - 0.5_wp*(vel_grad_l(2, 2)*vel_l(3) + vel_grad_r(2, 2)*vel_r(3))
6389
6390 flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, l) = flux_src_vf(eqn_idx%mom%beg + 2)%sf(j, k, &
6391 & l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6392 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
6393 & l) - 0.5_wp*(vel_grad_l(3, 3)*vel_l(3) + vel_grad_r(3, 3)*vel_r(3))
6394# 1673 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6395 end if
6396 end if
6397 end do
6398 end do
6399 end do
6400
6401# 1678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6402#if defined(MFC_OpenACC)
6403# 1678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6404!$acc end parallel loop
6405# 1678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6406#elif defined(MFC_OpenMP)
6407# 1678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6408
6409# 1678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6410!$omp end target teams loop
6411# 1678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6412#endif
6413 end if
6414
6415 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
6416
6417 end subroutine s_lf_riemann_solver
6418
6419 !> HLLC Riemann solver with contact restoration, Toro et al. Shock Waves (1994)
6420 subroutine s_hllc_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, &
6421
6422 & 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, &
6423 & flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
6424
6425 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, qr_prim_rsx_vf
6426 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
6427 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
6428 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
6429 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
6430
6431 ! Intercell fluxes
6432 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
6433 integer, intent(in) :: norm_dir
6434 type(int_bounds_info), intent(in) :: ix, iy, iz
6435
6436# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6437 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
6438 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
6439 real(wp), dimension(num_dims) :: vel_l, vel_r
6440# 1711 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6441
6442 real(wp) :: rho_l, rho_r
6443 real(wp) :: pres_l, pres_r
6444 real(wp) :: e_l, e_r
6445 real(wp) :: h_l, h_r
6446# 1720 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6447 real(wp), dimension(num_species) :: ys_l, ys_r, xs_l, xs_r, gamma_il, gamma_ir, cp_il, cp_ir
6448 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
6449# 1723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6450 real(wp) :: cp_avg, cv_avg, t_avg, c_sum_yi_phi, eps
6451 real(wp) :: t_l, t_r
6452 real(wp) :: mw_l, mw_r
6453 real(wp) :: r_gas_l, r_gas_r
6454 real(wp) :: cp_l, cp_r
6455 real(wp) :: cv_l, cv_r
6456 real(wp) :: gamm_l, gamm_r
6457 real(wp) :: y_l, y_r
6458 real(wp) :: gamma_l, gamma_r
6459 real(wp) :: pi_inf_l, pi_inf_r
6460 real(wp) :: qv_l, qv_r
6461 real(wp) :: c_l, c_r
6462 real(wp), dimension(2) :: re_l, re_r
6463 real(wp) :: rho_avg
6464 real(wp) :: h_avg
6465 real(wp) :: gamma_avg
6466 real(wp) :: qv_avg
6467 real(wp) :: c_avg
6468 real(wp) :: s_l, s_r, s_m, s_p, s_s
6469 real(wp) :: xi_l, xi_r !< Left and right wave speeds functions
6470 real(wp) :: xi_l_m1, xi_r_m1 !< xi_L/R - 1, computed without cancellation
6471 real(wp) :: xi_m, xi_p
6472 real(wp) :: xi_mp, xi_pp
6473# 1752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6474 real(wp), dimension(nb) :: r0_l, r0_r
6475 real(wp), dimension(nb) :: v0_l, v0_r
6476 real(wp), dimension(nb) :: p0_l, p0_r
6477 real(wp), dimension(nb) :: pbw_l, pbw_r
6478# 1757 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6479
6480 real(wp) :: alpha_l_sum, alpha_r_sum, nbub_l, nbub_r
6481 real(wp) :: ptilde_l, ptilde_r
6482 real(wp) :: pbwr3lbar, pbwr3rbar
6483 real(wp) :: r3lbar, r3rbar
6484 real(wp) :: r3v2lbar, r3v2rbar
6485 real(wp), dimension(6) :: tau_e_l, tau_e_r
6486# 1767 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6487 real(wp), dimension(num_dims) :: xi_field_l, xi_field_r
6488# 1769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6489 real(wp) :: g_l, g_r
6490 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
6491 real(wp) :: vel_l_tmp, vel_r_tmp
6492 real(wp) :: rho_star, e_star, p_star, p_k_star, vel_k_star
6493 real(wp) :: pres_sl, pres_sr, ms_l, ms_r
6494 real(wp) :: flux_ene_e
6495 real(wp) :: zcoef, pcorr !< low Mach number correction
6496 integer :: re_max, i, j, k, l, q !< Generic loop iterators
6497 ! Populating the buffers of the left and right Riemann problem states variables, based on the choice of boundary conditions
6498
6499 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
6500 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
6501
6502 ! Reshaping inputted data based on dimensional splitting direction
6503
6504 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
6505
6506# 1790 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6507# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6508# 1792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6509 if (norm_dir == 1) then
6510 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
6511 if (model_eqns == 3) then
6512 ! 6-equation model (model_eqns=3): separate phasic internal energies
6513
6514# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6515
6516# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6517#if defined(MFC_OpenACC)
6518# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6519!$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)
6520# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6521#elif defined(MFC_OpenMP)
6522# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6523
6524# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6525
6526# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6527
6528# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6529!$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)
6530# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6531#endif
6532# 1806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6533 do l = is3%beg, is3%end
6534 do k = is2%beg, is2%end
6535 do j = is1%beg, is1%end
6536 vel_l_rms = 0._wp; vel_r_rms = 0._wp
6537 rho_l = 0._wp; rho_r = 0._wp
6538 gamma_l = 0._wp; gamma_r = 0._wp
6539 pi_inf_l = 0._wp; pi_inf_r = 0._wp
6540 qv_l = 0._wp; qv_r = 0._wp
6541 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
6542
6543
6544# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6545#if defined(MFC_OpenACC)
6546# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6547!$acc loop seq
6548# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6549#elif defined(MFC_OpenMP)
6550# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6551
6552# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6553#endif
6554 do i = 1, num_dims
6555 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
6556 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
6557 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
6558 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
6559 end do
6560
6561 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
6562 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
6563
6564 rho_l = 0._wp
6565 gamma_l = 0._wp
6566 pi_inf_l = 0._wp
6567 qv_l = 0._wp
6568
6569 rho_r = 0._wp
6570 gamma_r = 0._wp
6571 pi_inf_r = 0._wp
6572 qv_r = 0._wp
6573
6574 alpha_l_sum = 0._wp
6575 alpha_r_sum = 0._wp
6576
6577 if (mpp_lim) then
6578
6579# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6580#if defined(MFC_OpenACC)
6581# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6582!$acc loop seq
6583# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6584#elif defined(MFC_OpenMP)
6585# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6586
6587# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6588#endif
6589 do i = 1, num_fluids
6590 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
6591 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
6592 & eqn_idx%E + i)), 1._wp)
6593 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
6594 end do
6595
6596
6597# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6598#if defined(MFC_OpenACC)
6599# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6600!$acc loop seq
6601# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6602#elif defined(MFC_OpenMP)
6603# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6604
6605# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6606#endif
6607 do i = 1, num_fluids
6608 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
6609 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
6610 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
6611 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
6612 end do
6613
6614
6615# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6616#if defined(MFC_OpenACC)
6617# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6618!$acc loop seq
6619# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6620#elif defined(MFC_OpenMP)
6621# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6622
6623# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6624#endif
6625 do i = 1, num_fluids
6626 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
6627 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
6628 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
6629 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
6630 end do
6631 end if
6632
6633
6634# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6635#if defined(MFC_OpenACC)
6636# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6637!$acc loop seq
6638# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6639#elif defined(MFC_OpenMP)
6640# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6641
6642# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6643#endif
6644 do i = 1, num_fluids
6645 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
6646 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
6647 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
6648 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
6649
6650 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
6651 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
6652 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
6653 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
6654
6655 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
6656 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%adv%beg + i - 1)
6657 end do
6658
6659 if (viscous) then
6660
6661# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6662#if defined(MFC_OpenACC)
6663# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6664!$acc loop seq
6665# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6666#elif defined(MFC_OpenMP)
6667# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6668
6669# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6670#endif
6671 do i = 1, 2
6672 re_l(i) = dflt_real
6673 re_r(i) = dflt_real
6674 if (re_size(i) > 0) re_l(i) = 0._wp
6675 if (re_size(i) > 0) re_r(i) = 0._wp
6676
6677# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6678#if defined(MFC_OpenACC)
6679# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6680!$acc loop seq
6681# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6682#elif defined(MFC_OpenMP)
6683# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6684
6685# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6686#endif
6687 do q = 1, re_size(i)
6688 re_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
6689 re_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, &
6690 & q) + re_r(i)
6691 end do
6692 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6693 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6694 end do
6695 end if
6696
6697 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
6698 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
6699
6700 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
6701 if (hypoelasticity) then
6702
6703# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6704#if defined(MFC_OpenACC)
6705# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6706!$acc loop seq
6707# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6708#elif defined(MFC_OpenMP)
6709# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6710
6711# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6712#endif
6713 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6714 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
6715 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
6716 end do
6717 g_l = 0._wp; g_r = 0._wp
6718
6719# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6720#if defined(MFC_OpenACC)
6721# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6722!$acc loop seq
6723# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6724#elif defined(MFC_OpenMP)
6725# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6726
6727# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6728#endif
6729 do i = 1, num_fluids
6730 g_l = g_l + alpha_l(i)*gs_rs(i)
6731 g_r = g_r + alpha_r(i)*gs_rs(i)
6732 end do
6733
6734# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6735#if defined(MFC_OpenACC)
6736# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6737!$acc loop seq
6738# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6739#elif defined(MFC_OpenMP)
6740# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6741
6742# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6743#endif
6744 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
6745 ! Elastic contribution to energy if G large enough
6746 if ((g_l > verysmall) .and. (g_r > verysmall)) then
6747 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6748 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6749 ! Additional terms in 2D and 3D
6750 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
6751 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6752 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6753 end if
6754 end if
6755 end do
6756 end if
6757
6758 ! Hyperelastic stress contribution: strain energy added to total energy
6759 if (hyperelasticity) then
6760
6761# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6762#if defined(MFC_OpenACC)
6763# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6764!$acc loop seq
6765# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6766#elif defined(MFC_OpenMP)
6767# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6768
6769# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6770#endif
6771 do i = 1, num_dims
6772 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
6773 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
6774 end do
6775 g_l = 0._wp; g_r = 0._wp
6776
6777# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6778#if defined(MFC_OpenACC)
6779# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6780!$acc loop seq
6781# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6782#elif defined(MFC_OpenMP)
6783# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6784
6785# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6786#endif
6787 do i = 1, num_fluids
6788 ! Mixture left and right shear modulus
6789 g_l = g_l + alpha_l(i)*gs_rs(i)
6790 g_r = g_r + alpha_r(i)*gs_rs(i)
6791 end do
6792 ! Elastic contribution to energy if G large enough
6793 if (g_l > verysmall .and. g_r > verysmall) then
6794 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
6795 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%end + 1)
6796 end if
6797
6798# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6799#if defined(MFC_OpenACC)
6800# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6801!$acc loop seq
6802# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6803#elif defined(MFC_OpenMP)
6804# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6805
6806# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6807#endif
6808 do i = 1, b_size - 1
6809 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
6810 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
6811 end do
6812 end if
6813
6814 h_l = (e_l + pres_l)/rho_l
6815 h_r = (e_r + pres_r)/rho_r
6816
6817 if (avg_state == 1) then
6818# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6819 rho_avg = sqrt(rho_l*rho_r)
6820# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6821
6822# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6823 vel_avg_rms = 0._wp
6824# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6825
6826# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6827
6828# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6829#if defined(MFC_OpenACC)
6830# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6831!$acc loop seq
6832# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6833#elif defined(MFC_OpenMP)
6834# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6835
6836# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6837#endif
6838# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6839 do i = 1, num_vels
6840# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6841 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
6842# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6843 end do
6844# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6845
6846# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6847 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
6848# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6849
6850# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6851 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
6852# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6853
6854# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6855 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
6856# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6857
6858# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6859 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
6860# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6861
6862# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6863 if (chemistry) then
6864# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6865 eps = 0.001_wp
6866# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6867 call get_species_enthalpies_rt(t_l, h_il)
6868# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6869 call get_species_enthalpies_rt(t_r, h_ir)
6870# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6871 h_il = h_il*gas_constant/molecular_weights*t_l
6872# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6873 h_ir = h_ir*gas_constant/molecular_weights*t_r
6874# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6875 call get_species_specific_heats_r(t_l, cp_il)
6876# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6877 call get_species_specific_heats_r(t_r, cp_ir)
6878# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6879
6880# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6881 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
6882# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6883 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
6884# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6885 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
6886# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6887 if (abs(t_l - t_r) < eps) then
6888# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6889 ! Case when T_L and T_R are very close
6890# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6891 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
6892# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6893 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
6894# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6895 & - gas_constant/molecular_weights(:)))
6896# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6897 else
6898# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6899 ! Normal calculation when T_L and T_R are sufficiently different
6900# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6901 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
6902# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6903 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
6904# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6905 end if
6906# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6907 gamma_avg = cp_avg/cv_avg
6908# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6909
6910# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6911 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
6912# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6913 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
6914# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6915 end if
6916# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6917 end if
6918# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6919
6920# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6921 if (avg_state == 2) then
6922# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6923 rho_avg = 5.e-1_wp*(rho_l + rho_r)
6924# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6925 vel_avg_rms = 0._wp
6926# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6927
6928# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6929#if defined(MFC_OpenACC)
6930# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6931!$acc loop seq
6932# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6933#elif defined(MFC_OpenMP)
6934# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6935
6936# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6937#endif
6938# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6939 do i = 1, num_vels
6940# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6941 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
6942# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6943 end do
6944# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6945
6946# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6947 h_avg = 5.e-1_wp*(h_l + h_r)
6948# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6949 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
6950# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6951 qv_avg = 5.e-1_wp*(qv_l + qv_r)
6952# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6953 end if
6954
6955 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
6956 & c_l, qv_l)
6957
6958 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
6959 & c_r, qv_r)
6960
6961 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
6962 ! variables are placeholders to call the subroutine.
6963 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
6964 & 0._wp, c_avg, qv_avg)
6965
6966 if (viscous) then
6967
6968# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6969#if defined(MFC_OpenACC)
6970# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6971!$acc loop seq
6972# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6973#elif defined(MFC_OpenMP)
6974# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6975
6976# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6977#endif
6978 do i = 1, 2
6979 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
6980 end do
6981 end if
6982
6983 ! Low Mach correction
6984 if (low_mach == 2) then
6985 if (riemann_solver == 1 .or. riemann_solver == 5) then
6986# 1982 "/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# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6989 pcorr = 0._wp
6990# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6991
6992# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6993 if (low_mach == 1) then
6994# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6995 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
6996# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6997 end if
6998# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6999 else if (riemann_solver == 2) then
7000# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7001 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7002# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7003 pcorr = 0._wp
7004# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7005
7006# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7007 if (low_mach == 1) then
7008# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7009 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))) &
7010# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7011 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7012# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7013 else if (low_mach == 2) then
7014# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7015 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))))
7016# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7017 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))))
7018# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7019 vel_l(dir_idx(1)) = vel_l_tmp
7020# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7021 vel_r(dir_idx(1)) = vel_r_tmp
7022# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7023 end if
7024# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7025 end if
7026 end if
7027
7028 ! COMPUTING THE DIRECT WAVE SPEEDS
7029 if (wave_speeds == 1) then
7030 if (elasticity) then
7031 ! Elastic wave speed, Rodriguez et al. JCP (2019)
7032 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) &
7033 & ))/rho_l), &
7034 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
7035 & + tau_e_r(dir_idx_tau(1)))/rho_r))
7036 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) &
7037 & ))/rho_r), &
7038 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
7039 & + tau_e_l(dir_idx_tau(1)))/rho_l))
7040 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
7041 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
7042 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
7043 & - vel_r(dir_idx(1))))
7044 else
7045 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7046 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7047 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7048 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
7049 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
7050 end if
7051 else if (wave_speeds == 2) then
7052 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7053
7054 pres_sr = pres_sl
7055
7056 ! Low Mach correction: Thornber et al. JCP (2008)
7057 ms_l = max(1._wp, &
7058 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
7059 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7060 ms_r = max(1._wp, &
7061 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
7062 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7063
7064 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7065 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7066
7067 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7068 end if
7069
7070 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7071 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7072
7073 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7074 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7075 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7076 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7077 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7078
7079 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7080 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
7081 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
7082
7083 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
7084 xi_mp = -min(0._wp, sign(1._wp, s_l))
7085 xi_pp = max(0._wp, sign(1._wp, s_r))
7086
7087 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 &
7088 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
7089 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
7090 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
7091 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
7092
7093 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))
7094
7095 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 &
7096 & - vel_r(dir_idx(1)))
7097
7098 ! Low Mach correction
7099 if (low_mach == 1) then
7100 if (riemann_solver == 1 .or. riemann_solver == 5) then
7101# 2057 "/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# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7104 pcorr = 0._wp
7105# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7106
7107# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7108 if (low_mach == 1) then
7109# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7110 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7111# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7112 end if
7113# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7114 else if (riemann_solver == 2) then
7115# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7116 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7117# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7118 pcorr = 0._wp
7119# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7120
7121# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7122 if (low_mach == 1) then
7123# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7124 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))) &
7125# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7126 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
7127# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7128 else if (low_mach == 2) then
7129# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7130 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))))
7131# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7132 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))))
7133# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7134 vel_l(dir_idx(1)) = vel_l_tmp
7135# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7136 vel_r(dir_idx(1)) = vel_r_tmp
7137# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7138 end if
7139# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7140 end if
7141 else
7142 pcorr = 0._wp
7143 end if
7144
7145 ! COMPUTING FLUXES MASS FLUX.
7146
7147# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7148#if defined(MFC_OpenACC)
7149# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7150!$acc loop seq
7151# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7152#elif defined(MFC_OpenMP)
7153# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7154
7155# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7156#endif
7157 do i = 1, eqn_idx%cont%end
7158 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7159 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7160 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7161 end do
7162
7163 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7164
7165# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7166#if defined(MFC_OpenACC)
7167# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7168!$acc loop seq
7169# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7170#elif defined(MFC_OpenMP)
7171# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7172
7173# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7174#endif
7175 do i = 1, num_dims
7176 flux_rsx_vf(j, k, l, &
7177 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
7178 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
7179 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
7180 & *dir_flg(dir_idx(i))*pcorr
7181 end do
7182
7183 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
7184 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
7185
7186 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
7187 if (elasticity) then
7188 flux_ene_e = 0._wp
7189
7190# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7191#if defined(MFC_OpenACC)
7192# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7193!$acc loop seq
7194# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7195#elif defined(MFC_OpenMP)
7196# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7197
7198# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7199#endif
7200 do i = 1, num_dims
7201 ! MOMENTUM ELASTIC FLUX.
7202 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
7203 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
7204 & - xi_p*tau_e_r(dir_idx_tau(i))
7205 ! ENERGY ELASTIC FLUX.
7206 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
7207 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
7208 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
7209 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
7210 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
7211 end do
7212 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
7213 end if
7214
7215 ! VOLUME FRACTION FLUX.
7216
7217# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7218#if defined(MFC_OpenACC)
7219# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7220!$acc loop seq
7221# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7222#elif defined(MFC_OpenMP)
7223# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7224
7225# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7226#endif
7227 do i = eqn_idx%adv%beg, eqn_idx%adv%end
7228 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7229 & i)*s_s + xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*s_s
7230 end do
7231
7232 ! Advection velocity source: interface velocity for volume fraction transport
7233
7234# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7235#if defined(MFC_OpenACC)
7236# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7237!$acc loop seq
7238# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7239#elif defined(MFC_OpenMP)
7240# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7241
7242# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7243#endif
7244 do i = 1, num_dims
7245 vel_src_rsx_vf(j, k, l, &
7246 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
7247 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
7248 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
7249 end do
7250
7251 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
7252 ! energy flux
7253
7254# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7255#if defined(MFC_OpenACC)
7256# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7257!$acc loop seq
7258# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7259#elif defined(MFC_OpenMP)
7260# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7261
7262# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7263#endif
7264 do i = 1, num_fluids
7265 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
7266 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
7267 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
7268 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
7269 & + pres_r)
7270
7271 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
7272 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7273 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
7274 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
7275 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7276 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
7277 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
7278 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7279 & i + eqn_idx%adv%beg - 1))
7280 end do
7281
7282 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7283
7284 ! HYPOELASTIC STRESS EVOLUTION FLUX.
7285 if (hypoelasticity) then
7286
7287# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7288#if defined(MFC_OpenACC)
7289# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7290!$acc loop seq
7291# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7292#elif defined(MFC_OpenMP)
7293# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7294
7295# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7296#endif
7297 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
7298 flux_rsx_vf(j, k, l, &
7299 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
7300 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
7301 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
7302 end do
7303 end if
7304
7305 ! Hyperelastic reference map flux for material deformation tracking
7306 if (hyperelasticity) then
7307
7308# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7309#if defined(MFC_OpenACC)
7310# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7311!$acc loop seq
7312# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7313#elif defined(MFC_OpenMP)
7314# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7315
7316# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7317#endif
7318 do i = 1, num_dims
7319 flux_rsx_vf(j, k, l, &
7320 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
7321 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
7322 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
7323 end do
7324 end if
7325
7326 ! COLOR FUNCTION FLUX
7327 if (surface_tension) then
7328 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
7329 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c))*s_s
7330 end if
7331
7332 ! Geometrical source flux for cylindrical coordinates
7333# 2192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7334# 2205 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7335 end do
7336 end do
7337 end do
7338
7339# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7340#if defined(MFC_OpenACC)
7341# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7342!$acc end parallel loop
7343# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7344#elif defined(MFC_OpenMP)
7345# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7346
7347# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7348!$omp end target teams loop
7349# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7350#endif
7351 else if (model_eqns == 4) then
7352 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
7353
7354# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7355
7356# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7357#if defined(MFC_OpenACC)
7358# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7359!$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)
7360# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7361#elif defined(MFC_OpenMP)
7362# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7363
7364# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7365
7366# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7367
7368# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7369!$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)
7370# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7371#endif
7372# 2220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7373 do l = is3%beg, is3%end
7374 do k = is2%beg, is2%end
7375 do j = is1%beg, is1%end
7376 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7377 rho_l = 0._wp; rho_r = 0._wp
7378 gamma_l = 0._wp; gamma_r = 0._wp
7379 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7380 qv_l = 0._wp; qv_r = 0._wp
7381
7382
7383# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7384#if defined(MFC_OpenACC)
7385# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7386!$acc loop seq
7387# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7388#elif defined(MFC_OpenMP)
7389# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7390
7391# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7392#endif
7393 do i = 1, eqn_idx%cont%end
7394 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
7395 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
7396 end do
7397
7398
7399# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7400#if defined(MFC_OpenACC)
7401# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7402!$acc loop seq
7403# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7404#elif defined(MFC_OpenMP)
7405# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7406
7407# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7408#endif
7409 do i = 1, num_dims
7410 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7411 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
7412 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7413 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7414 end do
7415
7416
7417# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7418#if defined(MFC_OpenACC)
7419# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7420!$acc loop seq
7421# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7422#elif defined(MFC_OpenMP)
7423# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7424
7425# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7426#endif
7427 do i = 1, num_fluids
7428 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7429 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
7430 end do
7431
7432# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7433#if defined(MFC_OpenACC)
7434# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7435!$acc loop seq
7436# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7437#elif defined(MFC_OpenMP)
7438# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7439
7440# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7441#endif
7442 do i = 1, num_fluids
7443 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7444 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
7445 end do
7446
7447
7448# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7449#if defined(MFC_OpenACC)
7450# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7451!$acc loop seq
7452# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7453#elif defined(MFC_OpenMP)
7454# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7455
7456# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7457#endif
7458 do i = 1, num_fluids
7459 rho_l = rho_l + alpha_rho_l(i)
7460 gamma_l = gamma_l + alpha_l(i)*gammas(i)
7461 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
7462 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
7463
7464 rho_r = rho_r + alpha_rho_r(i)
7465 gamma_r = gamma_r + alpha_r(i)*gammas(i)
7466 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
7467 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
7468 end do
7469
7470 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7471 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
7472
7473 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
7474 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
7475
7476 h_l = (e_l + pres_l)/rho_l
7477 h_r = (e_r + pres_r)/rho_r
7478
7479 if (avg_state == 1) then
7480# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7481 rho_avg = sqrt(rho_l*rho_r)
7482# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7483
7484# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7485 vel_avg_rms = 0._wp
7486# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7487
7488# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7489
7490# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7491#if defined(MFC_OpenACC)
7492# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7493!$acc loop seq
7494# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7495#elif defined(MFC_OpenMP)
7496# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7497
7498# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7499#endif
7500# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7501 do i = 1, num_vels
7502# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7503 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
7504# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7505 end do
7506# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7507
7508# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7509 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
7510# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7511
7512# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7513 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
7514# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7515
7516# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7517 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
7518# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7519
7520# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7521 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
7522# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7523
7524# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7525 if (chemistry) then
7526# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7527 eps = 0.001_wp
7528# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7529 call get_species_enthalpies_rt(t_l, h_il)
7530# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7531 call get_species_enthalpies_rt(t_r, h_ir)
7532# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7533 h_il = h_il*gas_constant/molecular_weights*t_l
7534# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7535 h_ir = h_ir*gas_constant/molecular_weights*t_r
7536# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7537 call get_species_specific_heats_r(t_l, cp_il)
7538# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7539 call get_species_specific_heats_r(t_r, cp_ir)
7540# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7541
7542# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7543 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
7544# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7545 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
7546# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7547 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
7548# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7549 if (abs(t_l - t_r) < eps) then
7550# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7551 ! Case when T_L and T_R are very close
7552# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7553 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
7554# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7555 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
7556# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7557 & - gas_constant/molecular_weights(:)))
7558# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7559 else
7560# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7561 ! Normal calculation when T_L and T_R are sufficiently different
7562# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7563 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
7564# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7565 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
7566# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7567 end if
7568# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7569 gamma_avg = cp_avg/cv_avg
7570# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7571
7572# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7573 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
7574# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7575 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
7576# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7577 end if
7578# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7579 end if
7580# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7581
7582# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7583 if (avg_state == 2) then
7584# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7585 rho_avg = 5.e-1_wp*(rho_l + rho_r)
7586# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7587 vel_avg_rms = 0._wp
7588# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7589
7590# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7591#if defined(MFC_OpenACC)
7592# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7593!$acc loop seq
7594# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7595#elif defined(MFC_OpenMP)
7596# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7597
7598# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7599#endif
7600# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7601 do i = 1, num_vels
7602# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7603 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
7604# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7605 end do
7606# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7607
7608# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7609 h_avg = 5.e-1_wp*(h_l + h_r)
7610# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7611 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
7612# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7613 qv_avg = 5.e-1_wp*(qv_l + qv_r)
7614# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7615 end if
7616
7617 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
7618 & c_l, qv_l)
7619
7620 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
7621 & c_r, qv_r)
7622
7623 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
7624 ! variables are placeholders to call the subroutine.
7625
7626 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
7627 & 0._wp, c_avg, qv_avg)
7628
7629 if (wave_speeds == 1) then
7630 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7631 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7632
7633 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
7634 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
7635 & - rho_r*(s_r - vel_r(dir_idx(1))))
7636 else if (wave_speeds == 2) then
7637 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
7638
7639 pres_sr = pres_sl
7640
7641 ! Low Mach correction: Thornber et al. JCP (2008)
7642 ms_l = max(1._wp, &
7643 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
7644 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7645 ms_r = max(1._wp, &
7646 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
7647 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7648
7649 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7650 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7651
7652 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
7653 end if
7654
7655 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
7656 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7657
7658 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7659 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7660 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7661 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
7662 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
7663
7664 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
7665 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
7666 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
7667
7668
7669# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7670#if defined(MFC_OpenACC)
7671# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7672!$acc loop seq
7673# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7674#elif defined(MFC_OpenMP)
7675# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7676
7677# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7678#endif
7679 do i = 1, eqn_idx%cont%end
7680 flux_rsx_vf(j, k, l, &
7681 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
7682 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7683 end do
7684
7685 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7686
7687# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7688#if defined(MFC_OpenACC)
7689# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7690!$acc loop seq
7691# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7692#elif defined(MFC_OpenMP)
7693# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7694
7695# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7696#endif
7697 do i = 1, num_dims
7698 flux_rsx_vf(j, k, l, &
7699 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
7700 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7701 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
7702 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
7703 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
7704 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
7705 end do
7706
7707 if (bubbles_euler) then
7708 ! Put p_tilde in
7709
7710# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7711#if defined(MFC_OpenACC)
7712# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7713!$acc loop seq
7714# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7715#elif defined(MFC_OpenMP)
7716# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7717
7718# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7719#endif
7720 do i = 1, num_dims
7721 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
7722 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
7723 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
7724 end do
7725 end if
7726
7727 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
7728
7729
7730# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7731#if defined(MFC_OpenACC)
7732# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7733!$acc loop seq
7734# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7735#elif defined(MFC_OpenMP)
7736# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7737
7738# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7739#endif
7740 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
7741 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
7742 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
7743 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7744 end do
7745
7746 ! Advection velocity source: interface velocity for volume fraction transport
7747
7748# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7749#if defined(MFC_OpenACC)
7750# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7751!$acc loop seq
7752# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7753#elif defined(MFC_OpenMP)
7754# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7755
7756# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7757#endif
7758 do i = 1, num_dims
7759 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
7760 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
7761 end do
7762
7763 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
7764
7765 ! Add advection flux for bubble variables
7766 if (bubbles_euler) then
7767
7768# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7769#if defined(MFC_OpenACC)
7770# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7771!$acc loop seq
7772# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7773#elif defined(MFC_OpenMP)
7774# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7775
7776# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7777#endif
7778 do i = eqn_idx%bub%beg, eqn_idx%bub%end
7779 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
7780 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
7781 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, &
7782 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
7783 end do
7784 end if
7785
7786 ! Geometrical source flux for cylindrical coordinates
7787
7788# 2411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7789# 2427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7790 end do
7791 end do
7792 end do
7793
7794# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7795#if defined(MFC_OpenACC)
7796# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7797!$acc end parallel loop
7798# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7799#elif defined(MFC_OpenMP)
7800# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7801
7802# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7803!$omp end target teams loop
7804# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7805#endif
7806 else if (model_eqns == 2 .and. bubbles_euler) then
7807 ! 5-equation model with Euler-Euler bubble dynamics
7808
7809# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7810
7811# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7812#if defined(MFC_OpenACC)
7813# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7814!$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)
7815# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7816#elif defined(MFC_OpenMP)
7817# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7818
7819# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7820
7821# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7822
7823# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7824!$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)
7825# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7826#endif
7827# 2441 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7828 do l = is3%beg, is3%end
7829 do k = is2%beg, is2%end
7830 do j = is1%beg, is1%end
7831 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7832 rho_l = 0._wp; rho_r = 0._wp
7833 gamma_l = 0._wp; gamma_r = 0._wp
7834 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7835 qv_l = 0._wp; qv_r = 0._wp
7836
7837
7838# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7839#if defined(MFC_OpenACC)
7840# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7841!$acc loop seq
7842# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7843#elif defined(MFC_OpenMP)
7844# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7845
7846# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7847#endif
7848 do i = 1, num_fluids
7849 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
7850 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
7851 end do
7852
7853 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7854
7855
7856# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7857#if defined(MFC_OpenACC)
7858# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7859!$acc loop seq
7860# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7861#elif defined(MFC_OpenMP)
7862# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7863
7864# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7865#endif
7866 do i = 1, num_dims
7867 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
7868 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
7869 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7870 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7871 end do
7872
7873 ! Retain this in the refactor
7874 if (mpp_lim .and. (num_fluids > 2)) then
7875
7876# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7877#if defined(MFC_OpenACC)
7878# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7879!$acc loop seq
7880# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7881#elif defined(MFC_OpenMP)
7882# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7883
7884# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7885#endif
7886 do i = 1, num_fluids
7887 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7888 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
7889 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
7890 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7891 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
7892 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
7893 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
7894 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
7895 end do
7896 else if (num_fluids > 2) then
7897
7898# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7899#if defined(MFC_OpenACC)
7900# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7901!$acc loop seq
7902# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7903#elif defined(MFC_OpenMP)
7904# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7905
7906# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7907#endif
7908 do i = 1, num_fluids - 1
7909 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7910 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
7911 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
7912 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7913 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
7914 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
7915 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
7916 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
7917 end do
7918 else
7919 rho_l = ql_prim_rsx_vf(j, k, l, 1)
7920 gamma_l = gammas(1)
7921 pi_inf_l = pi_infs(1)
7922 qv_l = qvs(1)
7923 rho_r = qr_prim_rsx_vf(j + 1, k, l, 1)
7924 gamma_r = gammas(1)
7925 pi_inf_r = pi_infs(1)
7926 qv_r = qvs(1)
7927 end if
7928
7929 if (viscous) then
7930 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
7931
7932# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7933#if defined(MFC_OpenACC)
7934# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7935!$acc loop seq
7936# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7937#elif defined(MFC_OpenMP)
7938# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7939
7940# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7941#endif
7942 do i = 1, 2
7943 re_l(i) = dflt_real
7944 re_r(i) = dflt_real
7945
7946 if (re_size(i) > 0) re_l(i) = 0._wp
7947 if (re_size(i) > 0) re_r(i) = 0._wp
7948
7949
7950# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7951#if defined(MFC_OpenACC)
7952# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7953!$acc loop seq
7954# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7955#elif defined(MFC_OpenMP)
7956# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7957
7958# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7959#endif
7960 do q = 1, re_size(i)
7961 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
7962 & q)))/res_gs(i, q) + re_l(i)
7963 re_r(i) = (1._wp - qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + re_idx(i, &
7964 & q)))/res_gs(i, q) + re_r(i)
7965 end do
7966
7967 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
7968 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
7969 end do
7970 end if
7971 end if
7972
7973 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
7974 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
7975
7976 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
7977 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
7978
7979 h_l = (e_l + pres_l)/rho_l
7980 h_r = (e_r + pres_r)/rho_r
7981
7982 if (avg_state == 2) then
7983
7984# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7985#if defined(MFC_OpenACC)
7986# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7987!$acc loop seq
7988# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7989#elif defined(MFC_OpenMP)
7990# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7991
7992# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7993#endif
7994 do i = 1, nb
7995 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
7996 r0_r(i) = qr_prim_rsx_vf(j + 1, k, l, rs(i))
7997
7998 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
7999 v0_r(i) = qr_prim_rsx_vf(j + 1, k, l, vs(i))
8000 if (.not. polytropic .and. .not. qbmm) then
8001 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
8002 p0_r(i) = qr_prim_rsx_vf(j + 1, k, l, ps(i))
8003 end if
8004 end do
8005
8006 if (.not. qbmm) then
8007 if (adv_n) then
8008 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
8009 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%n)
8010 else
8011 nbub_l = 0._wp
8012 nbub_r = 0._wp
8013
8014# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8015#if defined(MFC_OpenACC)
8016# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8017!$acc loop seq
8018# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8019#elif defined(MFC_OpenMP)
8020# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8021
8022# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8023#endif
8024 do i = 1, nb
8025 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
8026 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
8027 end do
8028
8029 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
8030 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j + 1, k, l, &
8031 & eqn_idx%E + num_fluids)/nbub_r
8032 end if
8033 else
8034 ! nb stored in 0th moment of first R0 bin in variable conversion module
8035 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
8036 nbub_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%bub%beg)
8037 end if
8038
8039
8040# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8041#if defined(MFC_OpenACC)
8042# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8043!$acc loop seq
8044# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8045#elif defined(MFC_OpenMP)
8046# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8047
8048# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8049#endif
8050 do i = 1, nb
8051 if (.not. qbmm) then
8052 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
8053 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
8054 end if
8055 end do
8056
8057 if (qbmm) then
8058 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
8059 pbwr3rbar = mom_sp_rsx_vf(j + 1, k, l, 4)
8060
8061 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
8062 r3rbar = mom_sp_rsx_vf(j + 1, k, l, 1)
8063
8064 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
8065 r3v2rbar = mom_sp_rsx_vf(j + 1, k, l, 3)
8066 else
8067 pbwr3lbar = 0._wp
8068 pbwr3rbar = 0._wp
8069
8070 r3lbar = 0._wp
8071 r3rbar = 0._wp
8072
8073 r3v2lbar = 0._wp
8074 r3v2rbar = 0._wp
8075
8076
8077# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8078#if defined(MFC_OpenACC)
8079# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8080!$acc loop seq
8081# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8082#elif defined(MFC_OpenMP)
8083# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8084
8085# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8086#endif
8087 do i = 1, nb
8088 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
8089 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
8090
8091 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
8092 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
8093
8094 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
8095 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
8096 end do
8097 end if
8098
8099 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8100 h_avg = 5.e-1_wp*(h_l + h_r)
8101 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8102 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8103 vel_avg_rms = 0._wp
8104
8105
8106# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8107#if defined(MFC_OpenACC)
8108# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8109!$acc loop seq
8110# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8111#elif defined(MFC_OpenMP)
8112# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8113
8114# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8115#endif
8116 do i = 1, num_dims
8117 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8118 end do
8119 end if
8120
8121 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
8122 & c_l, qv_l)
8123
8124 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
8125 & c_r, qv_r)
8126
8127 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8128 ! variables are placeholders to call the subroutine.
8129 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
8130 & 0._wp, c_avg, qv_avg)
8131
8132 if (viscous) then
8133
8134# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8135#if defined(MFC_OpenACC)
8136# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8137!$acc loop seq
8138# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8139#elif defined(MFC_OpenMP)
8140# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8141
8142# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8143#endif
8144 do i = 1, 2
8145 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
8146 end do
8147 end if
8148
8149 ! Low Mach correction
8150 if (low_mach == 2) then
8151 if (riemann_solver == 1 .or. riemann_solver == 5) then
8152# 2644 "/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# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8155 pcorr = 0._wp
8156# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8157
8158# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8159 if (low_mach == 1) then
8160# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8161 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8162# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8163 end if
8164# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8165 else if (riemann_solver == 2) then
8166# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8167 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8168# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8169 pcorr = 0._wp
8170# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8171
8172# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8173 if (low_mach == 1) then
8174# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8175 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))) &
8176# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8177 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8178# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8179 else if (low_mach == 2) then
8180# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8181 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))))
8182# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8183 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))))
8184# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8185 vel_l(dir_idx(1)) = vel_l_tmp
8186# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8187 vel_r(dir_idx(1)) = vel_r_tmp
8188# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8189 end if
8190# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8191 end if
8192 end if
8193
8194 if (wave_speeds == 1) then
8195 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
8196 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
8197
8198 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
8199 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
8200 & - rho_r*(s_r - vel_r(dir_idx(1))))
8201 else if (wave_speeds == 2) then
8202 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
8203
8204 pres_sr = pres_sl
8205
8206 ! Low Mach correction: Thornber et al. JCP (2008)
8207 ms_l = max(1._wp, &
8208 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
8209 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
8210 ms_r = max(1._wp, &
8211 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
8212 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
8213
8214 s_l = vel_l(dir_idx(1)) - c_l*ms_l
8215 s_r = vel_r(dir_idx(1)) + c_r*ms_r
8216
8217 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
8218 end if
8219
8220 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
8221 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
8222
8223 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
8224 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8225 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8226 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
8227 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
8228
8229 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
8230 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
8231 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
8232
8233 ! Low Mach correction
8234 if (low_mach == 1) then
8235 if (riemann_solver == 1 .or. riemann_solver == 5) then
8236# 2688 "/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# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8239 pcorr = 0._wp
8240# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8241
8242# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8243 if (low_mach == 1) then
8244# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8245 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8246# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8247 end if
8248# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8249 else if (riemann_solver == 2) then
8250# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8251 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8252# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8253 pcorr = 0._wp
8254# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8255
8256# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8257 if (low_mach == 1) then
8258# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8259 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))) &
8260# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8261 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
8262# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8263 else if (low_mach == 2) then
8264# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8265 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))))
8266# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8267 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))))
8268# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8269 vel_l(dir_idx(1)) = vel_l_tmp
8270# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8271 vel_r(dir_idx(1)) = vel_r_tmp
8272# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8273 end if
8274# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8275 end if
8276 else
8277 pcorr = 0._wp
8278 end if
8279
8280
8281# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8282#if defined(MFC_OpenACC)
8283# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8284!$acc loop seq
8285# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8286#elif defined(MFC_OpenMP)
8287# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8288
8289# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8290#endif
8291 do i = 1, eqn_idx%cont%end
8292 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8293 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
8294 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8295 end do
8296
8297 if (bubbles_euler .and. (num_fluids > 1)) then
8298 ! Kill mass transport @ gas density
8299 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
8300 end if
8301
8302 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
8303
8304 ! Include p_tilde
8305
8306 if (avg_state == 2) then
8307 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
8308 pres_l = pres_l - alpha_l(num_fluids)*pres_l
8309 else
8310 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
8311 end if
8312
8313 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
8314 pres_r = pres_r - alpha_r(num_fluids)*pres_r
8315 else
8316 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
8317 end if
8318 end if
8319
8320
8321# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8322#if defined(MFC_OpenACC)
8323# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8324!$acc loop seq
8325# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8326#elif defined(MFC_OpenMP)
8327# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8328
8329# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8330#endif
8331 do i = 1, num_dims
8332 flux_rsx_vf(j, k, l, &
8333 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
8334 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
8335 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
8336 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
8337 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
8338 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
8339 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
8340 end do
8341
8342 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
8343 flux_rsx_vf(j, k, l, &
8344 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
8345 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
8346 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
8347 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
8348 & *pcorr*s_s
8349
8350 ! Volume fraction flux
8351
8352# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8353#if defined(MFC_OpenACC)
8354# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8355!$acc loop seq
8356# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8357#elif defined(MFC_OpenMP)
8358# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8359
8360# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8361#endif
8362 do i = eqn_idx%adv%beg, eqn_idx%adv%end
8363 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
8364 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
8365 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8366 end do
8367
8368 ! Advection velocity source: interface velocity for volume fraction transport
8369
8370# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8371#if defined(MFC_OpenACC)
8372# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8373!$acc loop seq
8374# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8375#elif defined(MFC_OpenMP)
8376# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8377
8378# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8379#endif
8380 do i = 1, num_dims
8381 vel_src_rsx_vf(j, k, l, &
8382 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
8383 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
8384
8385 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
8386 end do
8387
8388 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
8389
8390 ! Add advection flux for bubble variables
8391
8392# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8393#if defined(MFC_OpenACC)
8394# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8395!$acc loop seq
8396# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8397#elif defined(MFC_OpenMP)
8398# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8399
8400# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8401#endif
8402 do i = eqn_idx%bub%beg, eqn_idx%bub%end
8403 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
8404 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8405 & + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8406 end do
8407
8408 if (qbmm) then
8409 flux_rsx_vf(j, k, l, &
8410 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8411 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8412 end if
8413
8414 if (adv_n) then
8415 flux_rsx_vf(j, k, l, &
8416 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
8417 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
8418 end if
8419
8420 ! Geometrical source flux for cylindrical coordinates
8421# 2806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8422# 2823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8423 end do
8424 end do
8425 end do
8426
8427# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8428#if defined(MFC_OpenACC)
8429# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8430!$acc end parallel loop
8431# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8432#elif defined(MFC_OpenMP)
8433# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8434
8435# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8436!$omp end target teams loop
8437# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8438#endif
8439 else
8440 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
8441
8442# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8443
8444# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8445#if defined(MFC_OpenACC)
8446# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8447!$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)
8448# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8449#elif defined(MFC_OpenMP)
8450# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8451
8452# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8453
8454# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8455
8456# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8457!$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)
8458# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8459#endif
8460# 2838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8461 do l = is3%beg, is3%end
8462 do k = is2%beg, is2%end
8463 do j = is1%beg, is1%end
8464 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8465 rho_l = 0._wp; rho_r = 0._wp
8466 gamma_l = 0._wp; gamma_r = 0._wp
8467 pi_inf_l = 0._wp; pi_inf_r = 0._wp
8468 qv_l = 0._wp; qv_r = 0._wp
8469 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
8470
8471
8472# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8473#if defined(MFC_OpenACC)
8474# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8475!$acc loop seq
8476# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8477#elif defined(MFC_OpenMP)
8478# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8479
8480# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8481#endif
8482 do i = 1, num_fluids
8483 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8484 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
8485 end do
8486
8487
8488# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8489#if defined(MFC_OpenACC)
8490# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8491!$acc loop seq
8492# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8493#elif defined(MFC_OpenMP)
8494# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8495
8496# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8497#endif
8498 do i = 1, num_dims
8499 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
8500 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + i)
8501 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
8502 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
8503 end do
8504
8505 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
8506 pres_r = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
8507
8508 ! Change this by splitting it into the cases present in the bubbles_euler
8509 if (mpp_lim) then
8510
8511# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8512#if defined(MFC_OpenACC)
8513# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8514!$acc loop seq
8515# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8516#elif defined(MFC_OpenMP)
8517# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8518
8519# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8520#endif
8521 do i = 1, num_fluids
8522 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
8523 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
8524 & eqn_idx%E + i)), 1._wp)
8525 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
8526 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = min(max(0._wp, &
8527 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)), 1._wp)
8528 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
8529 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
8530 end do
8531
8532
8533# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8534#if defined(MFC_OpenACC)
8535# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8536!$acc loop seq
8537# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8538#elif defined(MFC_OpenMP)
8539# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8540
8541# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8542#endif
8543 do i = 1, num_fluids
8544 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
8545 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
8546 qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i) = qr_prim_rsx_vf(j + 1, k, l, &
8547 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
8548 end do
8549 end if
8550
8551
8552# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8553#if defined(MFC_OpenACC)
8554# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8555!$acc loop seq
8556# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8557#elif defined(MFC_OpenMP)
8558# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8559
8560# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8561#endif
8562 do i = 1, num_fluids
8563 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
8564 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
8565 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
8566 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
8567
8568 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
8569 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*gammas(i)
8570 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)*pi_infs(i)
8571 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
8572 end do
8573
8574 re_max = 0
8575 if (re_size(1) > 0) re_max = 1
8576 if (re_size(2) > 0) re_max = 2
8577
8578 if (viscous) then
8579
8580# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8581#if defined(MFC_OpenACC)
8582# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8583!$acc loop seq
8584# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8585#elif defined(MFC_OpenMP)
8586# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8587
8588# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8589#endif
8590 do i = 1, re_max
8591 re_l(i) = 0._wp
8592 re_r(i) = 0._wp
8593
8594
8595# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8596#if defined(MFC_OpenACC)
8597# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8598!$acc loop seq
8599# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8600#elif defined(MFC_OpenMP)
8601# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8602
8603# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8604#endif
8605 do q = 1, re_size(i)
8606 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
8607 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
8608 end do
8609
8610 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
8611 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
8612 end do
8613 end if
8614
8615 if (chemistry) then
8616 c_sum_yi_phi = 0.0_wp
8617
8618# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8619#if defined(MFC_OpenACC)
8620# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8621!$acc loop seq
8622# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8623#elif defined(MFC_OpenMP)
8624# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8625
8626# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8627#endif
8628 do i = eqn_idx%species%beg, eqn_idx%species%end
8629 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
8630 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
8631 end do
8632
8633 call get_mixture_molecular_weight(ys_l, mw_l)
8634 call get_mixture_molecular_weight(ys_r, mw_r)
8635
8636# 2937 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8637 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
8638 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
8639# 2940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8640
8641 r_gas_l = gas_constant/mw_l
8642 r_gas_r = gas_constant/mw_r
8643
8644 t_l = pres_l/rho_l/r_gas_l
8645 t_r = pres_r/rho_r/r_gas_r
8646
8647 call get_species_specific_heats_r(t_l, cp_il)
8648 call get_species_specific_heats_r(t_r, cp_ir)
8649
8650 if (chem_params%gamma_method == 1) then
8651 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
8652 gamma_il = cp_il/(cp_il - 1.0_wp)
8653 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
8654
8655 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
8656 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
8657 else if (chem_params%gamma_method == 2) then
8658 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
8659 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
8660 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
8661 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
8662 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
8663
8664 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
8665 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
8666 end if
8667
8668 call get_mixture_energy_mass(t_l, ys_l, e_l)
8669 call get_mixture_energy_mass(t_r, ys_r, e_r)
8670
8671 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
8672 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
8673 h_l = (e_l + pres_l)/rho_l
8674 h_r = (e_r + pres_r)/rho_r
8675 else
8676 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
8677 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
8678
8679 h_l = (e_l + pres_l)/rho_l
8680 h_r = (e_r + pres_r)/rho_r
8681 end if
8682
8683 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
8684 if (hypoelasticity) then
8685
8686# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8687#if defined(MFC_OpenACC)
8688# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8689!$acc loop seq
8690# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8691#elif defined(MFC_OpenMP)
8692# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8693
8694# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8695#endif
8696 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
8697 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
8698 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
8699 end do
8700 g_l = 0._wp
8701 g_r = 0._wp
8702
8703# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8704#if defined(MFC_OpenACC)
8705# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8706!$acc loop seq
8707# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8708#elif defined(MFC_OpenMP)
8709# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8710
8711# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8712#endif
8713 do i = 1, num_fluids
8714 g_l = g_l + alpha_l(i)*gs_rs(i)
8715 g_r = g_r + alpha_r(i)*gs_rs(i)
8716 end do
8717
8718# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8719#if defined(MFC_OpenACC)
8720# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8721!$acc loop seq
8722# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8723#elif defined(MFC_OpenMP)
8724# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8725
8726# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8727#endif
8728 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
8729 ! Elastic contribution to energy if G large enough
8730 if ((g_l > verysmall) .and. (g_r > verysmall)) then
8731 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
8732 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
8733 ! Additional terms in 2D and 3D
8734 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
8735 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
8736 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
8737 end if
8738 end if
8739 end do
8740 end if
8741
8742 ! Hyperelastic stress contribution: strain energy added to total energy
8743 if (hyperelasticity) then
8744
8745# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8746#if defined(MFC_OpenACC)
8747# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8748!$acc loop seq
8749# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8750#elif defined(MFC_OpenMP)
8751# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8752
8753# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8754#endif
8755 do i = 1, num_dims
8756 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
8757 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%beg - 1 + i)
8758 end do
8759 g_l = 0._wp
8760 g_r = 0._wp
8761
8762# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8763#if defined(MFC_OpenACC)
8764# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8765!$acc loop seq
8766# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8767#elif defined(MFC_OpenMP)
8768# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8769
8770# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8771#endif
8772 do i = 1, num_fluids
8773 ! Mixture left and right shear modulus
8774 g_l = g_l + alpha_l(i)*gs_rs(i)
8775 g_r = g_r + alpha_r(i)*gs_rs(i)
8776 end do
8777 ! Elastic contribution to energy if G large enough
8778 if (g_l > verysmall .and. g_r > verysmall) then
8779 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
8780 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%xi%end + 1)
8781 end if
8782
8783# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8784#if defined(MFC_OpenACC)
8785# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8786!$acc loop seq
8787# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8788#elif defined(MFC_OpenMP)
8789# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8790
8791# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8792#endif
8793 do i = 1, b_size - 1
8794 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
8795 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%stress%beg - 1 + i)
8796 end do
8797 end if
8798
8799 h_l = (e_l + pres_l)/rho_l
8800 h_r = (e_r + pres_r)/rho_r
8801
8802 if (avg_state == 1) then
8803# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8804 rho_avg = sqrt(rho_l*rho_r)
8805# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8806
8807# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8808 vel_avg_rms = 0._wp
8809# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8810
8811# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8812
8813# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8814#if defined(MFC_OpenACC)
8815# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8816!$acc loop seq
8817# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8818#elif defined(MFC_OpenMP)
8819# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8820
8821# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8822#endif
8823# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8824 do i = 1, num_vels
8825# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8826 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
8827# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8828 end do
8829# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8830
8831# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8832 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
8833# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8834
8835# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8836 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
8837# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8838
8839# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8840 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
8841# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8842
8843# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8844 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
8845# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8846
8847# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8848 if (chemistry) then
8849# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8850 eps = 0.001_wp
8851# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8852 call get_species_enthalpies_rt(t_l, h_il)
8853# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8854 call get_species_enthalpies_rt(t_r, h_ir)
8855# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8856 h_il = h_il*gas_constant/molecular_weights*t_l
8857# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8858 h_ir = h_ir*gas_constant/molecular_weights*t_r
8859# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8860 call get_species_specific_heats_r(t_l, cp_il)
8861# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8862 call get_species_specific_heats_r(t_r, cp_ir)
8863# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8864
8865# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8866 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
8867# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8868 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
8869# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8870 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
8871# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8872 if (abs(t_l - t_r) < eps) then
8873# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8874 ! Case when T_L and T_R are very close
8875# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8876 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
8877# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8878 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
8879# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8880 & - gas_constant/molecular_weights(:)))
8881# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8882 else
8883# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8884 ! Normal calculation when T_L and T_R are sufficiently different
8885# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8886 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
8887# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8888 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
8889# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8890 end if
8891# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8892 gamma_avg = cp_avg/cv_avg
8893# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8894
8895# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8896 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
8897# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8898 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
8899# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8900 end if
8901# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8902 end if
8903# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8904
8905# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8906 if (avg_state == 2) then
8907# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8908 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8909# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8910 vel_avg_rms = 0._wp
8911# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8912
8913# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8914#if defined(MFC_OpenACC)
8915# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8916!$acc loop seq
8917# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8918#elif defined(MFC_OpenMP)
8919# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8920
8921# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8922#endif
8923# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8924 do i = 1, num_vels
8925# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8926 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8927# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8928 end do
8929# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8930
8931# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8932 h_avg = 5.e-1_wp*(h_l + h_r)
8933# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8934 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8935# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8936 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8937# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8938 end if
8939
8940 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
8941 & c_l, qv_l)
8942
8943 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
8944 & c_r, qv_r)
8945
8946 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8947 ! variables are placeholders to call the subroutine.
8948 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
8949 & c_sum_yi_phi, c_avg, qv_avg)
8950
8951 if (viscous) then
8952 if (chemistry) then
8953 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
8954 end if
8955
8956# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8957#if defined(MFC_OpenACC)
8958# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8959!$acc loop seq
8960# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8961#elif defined(MFC_OpenMP)
8962# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8963
8964# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8965#endif
8966 do i = 1, 2
8967 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
8968 end do
8969 end if
8970
8971 ! Low Mach correction
8972 if (low_mach == 2) then
8973 if (riemann_solver == 1 .or. riemann_solver == 5) then
8974# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8975 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8976# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8977 pcorr = 0._wp
8978# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8979
8980# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8981 if (low_mach == 1) then
8982# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8983 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
8984# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8985 end if
8986# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8987 else if (riemann_solver == 2) then
8988# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8989 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
8990# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8991 pcorr = 0._wp
8992# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8993
8994# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8995 if (low_mach == 1) then
8996# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8997 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))) &
8998# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8999 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9000# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9001 else if (low_mach == 2) then
9002# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9003 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))))
9004# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9005 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))))
9006# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9007 vel_l(dir_idx(1)) = vel_l_tmp
9008# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9009 vel_r(dir_idx(1)) = vel_r_tmp
9010# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9011 end if
9012# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9013 end if
9014 end if
9015
9016 if (wave_speeds == 1) then
9017 if (elasticity) then
9018 ! Elastic wave speed, Rodriguez et al. JCP (2019)
9019 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) &
9020 & ))/rho_l), &
9021 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
9022 & + tau_e_r(dir_idx_tau(1)))/rho_r))
9023 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) &
9024 & ))/rho_r), &
9025 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
9026 & + tau_e_l(dir_idx_tau(1)))/rho_l))
9027 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
9028 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
9029 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
9030 & - vel_r(dir_idx(1))))
9031 else
9032 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
9033 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
9034 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
9035 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
9036 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
9037 end if
9038 else if (wave_speeds == 2) then
9039 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9040
9041 pres_sr = pres_sl
9042
9043 ! Low Mach correction: Thornber et al. JCP (2008)
9044 ms_l = max(1._wp, &
9045 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
9046 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
9047 ms_r = max(1._wp, &
9048 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
9049 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
9050
9051 s_l = vel_l(dir_idx(1)) - c_l*ms_l
9052 s_r = vel_r(dir_idx(1)) + c_r*ms_r
9053
9054 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
9055 end if
9056
9057 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
9058 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
9059
9060 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
9061 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
9062 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
9063 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
9064 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
9065 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
9066
9067 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
9068 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
9069 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
9070
9071 ! Low Mach correction
9072 if (low_mach == 1) then
9073 if (riemann_solver == 1 .or. riemann_solver == 5) then
9074# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9075 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9076# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9077 pcorr = 0._wp
9078# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9079
9080# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9081 if (low_mach == 1) then
9082# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9083 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9084# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9085 end if
9086# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9087 else if (riemann_solver == 2) then
9088# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9089 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9090# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9091 pcorr = 0._wp
9092# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9093
9094# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9095 if (low_mach == 1) then
9096# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9097 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))) &
9098# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9099 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9100# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9101 else if (low_mach == 2) then
9102# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9103 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))))
9104# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9105 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))))
9106# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9107 vel_l(dir_idx(1)) = vel_l_tmp
9108# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9109 vel_r(dir_idx(1)) = vel_r_tmp
9110# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9111 end if
9112# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9113 end if
9114 else
9115 pcorr = 0._wp
9116 end if
9117
9118 ! COMPUTING THE HLLC FLUXES MASS FLUX.
9119
9120# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9121#if defined(MFC_OpenACC)
9122# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9123!$acc loop seq
9124# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9125#elif defined(MFC_OpenMP)
9126# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9127
9128# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9129#endif
9130 do i = 1, eqn_idx%cont%end
9131 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9132 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
9133 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9134 end do
9135
9136 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
9137 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
9138
9139# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9140#if defined(MFC_OpenACC)
9141# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9142!$acc loop seq
9143# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9144#elif defined(MFC_OpenMP)
9145# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9146
9147# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9148#endif
9149 do i = 1, num_dims
9150 flux_rsx_vf(j, k, l, &
9151 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
9152 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
9153 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
9154 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
9155 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
9156 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
9157 end do
9158
9159 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
9160 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
9161 flux_rsx_vf(j, k, l, &
9162 & 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 &
9163 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
9164 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
9165 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
9166 & *(s_p/s_r)*pcorr*s_s
9167
9168 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
9169 if (elasticity) then
9170 flux_ene_e = 0._wp
9171
9172# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9173#if defined(MFC_OpenACC)
9174# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9175!$acc loop seq
9176# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9177#elif defined(MFC_OpenMP)
9178# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9179
9180# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9181#endif
9182 do i = 1, num_dims
9183 ! MOMENTUM ELASTIC FLUX.
9184 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
9185 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
9186 & - xi_p*tau_e_r(dir_idx_tau(i))
9187 ! ENERGY ELASTIC FLUX.
9188 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
9189 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
9190 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
9191 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
9192 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
9193 end do
9194 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
9195 end if
9196
9197 ! HYPOELASTIC STRESS EVOLUTION FLUX.
9198 if (hypoelasticity) then
9199
9200# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9201#if defined(MFC_OpenACC)
9202# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9203!$acc loop seq
9204# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9205#elif defined(MFC_OpenMP)
9206# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9207
9208# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9209#endif
9210 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
9211 flux_rsx_vf(j, k, l, &
9212 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
9213 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
9214 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
9215 end do
9216 end if
9217
9218 ! VOLUME FRACTION FLUX.
9219
9220# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9221#if defined(MFC_OpenACC)
9222# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9223!$acc loop seq
9224# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9225#elif defined(MFC_OpenMP)
9226# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9227
9228# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9229#endif
9230 do i = eqn_idx%adv%beg, eqn_idx%adv%end
9231 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9232 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, &
9233 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9234 end do
9235
9236 ! VOLUME FRACTION SOURCE FLUX.
9237
9238# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9239#if defined(MFC_OpenACC)
9240# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9241!$acc loop seq
9242# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9243#elif defined(MFC_OpenMP)
9244# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9245
9246# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9247#endif
9248 do i = 1, num_dims
9249 vel_src_rsx_vf(j, k, l, &
9250 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
9251 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
9252 end do
9253
9254 ! COLOR FUNCTION FLUX
9255 if (surface_tension) then
9256 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
9257 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
9258 & + xi_p*qr_prim_rsx_vf(j + 1, k, l, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9259 end if
9260
9261 ! Hyperelastic reference map flux for material deformation tracking
9262 if (hyperelasticity) then
9263
9264# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9265#if defined(MFC_OpenACC)
9266# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9267!$acc loop seq
9268# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9269#elif defined(MFC_OpenMP)
9270# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9271
9272# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9273#endif
9274 do i = 1, num_dims
9275 flux_rsx_vf(j, k, l, &
9276 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
9277 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
9278 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
9279 end do
9280 end if
9281
9282 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
9283
9284 if (chemistry) then
9285
9286# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9287#if defined(MFC_OpenACC)
9288# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9289!$acc loop seq
9290# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9291#elif defined(MFC_OpenMP)
9292# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9293
9294# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9295#endif
9296 do i = eqn_idx%species%beg, eqn_idx%species%end
9297 y_l = ql_prim_rsx_vf(j, k, l, i)
9298 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
9299
9300 flux_rsx_vf(j, k, l, &
9301 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
9302 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9303 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
9304 end do
9305 end if
9306
9307 ! Geometrical source flux for cylindrical coordinates
9308# 3264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9309# 3281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9310 end do
9311 end do
9312 end do
9313
9314# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9315#if defined(MFC_OpenACC)
9316# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9317!$acc end parallel loop
9318# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9319#elif defined(MFC_OpenMP)
9320# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9321
9322# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9323!$omp end target teams loop
9324# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9325#endif
9326 end if
9327 end if
9328# 1790 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9329# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9330# 1792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9331 if (norm_dir == 2) then
9332 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
9333 if (model_eqns == 3) then
9334 ! 6-equation model (model_eqns=3): separate phasic internal energies
9335
9336# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9337
9338# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9339#if defined(MFC_OpenACC)
9340# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9341!$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)
9342# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9343#elif defined(MFC_OpenMP)
9344# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9345
9346# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9347
9348# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9349
9350# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9351!$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)
9352# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9353#endif
9354# 1806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9355 do l = is3%beg, is3%end
9356 do k = is1%beg, is1%end
9357 do j = is2%beg, is2%end
9358 vel_l_rms = 0._wp; vel_r_rms = 0._wp
9359 rho_l = 0._wp; rho_r = 0._wp
9360 gamma_l = 0._wp; gamma_r = 0._wp
9361 pi_inf_l = 0._wp; pi_inf_r = 0._wp
9362 qv_l = 0._wp; qv_r = 0._wp
9363 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
9364
9365
9366# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9367#if defined(MFC_OpenACC)
9368# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9369!$acc loop seq
9370# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9371#elif defined(MFC_OpenMP)
9372# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9373
9374# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9375#endif
9376 do i = 1, num_dims
9377 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
9378 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
9379 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
9380 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
9381 end do
9382
9383 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
9384 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
9385
9386 rho_l = 0._wp
9387 gamma_l = 0._wp
9388 pi_inf_l = 0._wp
9389 qv_l = 0._wp
9390
9391 rho_r = 0._wp
9392 gamma_r = 0._wp
9393 pi_inf_r = 0._wp
9394 qv_r = 0._wp
9395
9396 alpha_l_sum = 0._wp
9397 alpha_r_sum = 0._wp
9398
9399 if (mpp_lim) then
9400
9401# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9402#if defined(MFC_OpenACC)
9403# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9404!$acc loop seq
9405# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9406#elif defined(MFC_OpenMP)
9407# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9408
9409# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9410#endif
9411 do i = 1, num_fluids
9412 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
9413 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
9414 & eqn_idx%E + i)), 1._wp)
9415 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
9416 end do
9417
9418
9419# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9420#if defined(MFC_OpenACC)
9421# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9422!$acc loop seq
9423# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9424#elif defined(MFC_OpenMP)
9425# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9426
9427# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9428#endif
9429 do i = 1, num_fluids
9430 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
9431 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
9432 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
9433 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
9434 end do
9435
9436
9437# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9438#if defined(MFC_OpenACC)
9439# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9440!$acc loop seq
9441# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9442#elif defined(MFC_OpenMP)
9443# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9444
9445# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9446#endif
9447 do i = 1, num_fluids
9448 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
9449 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
9450 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
9451 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
9452 end do
9453 end if
9454
9455
9456# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9457#if defined(MFC_OpenACC)
9458# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9459!$acc loop seq
9460# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9461#elif defined(MFC_OpenMP)
9462# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9463
9464# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9465#endif
9466 do i = 1, num_fluids
9467 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
9468 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
9469 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
9470 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
9471
9472 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
9473 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
9474 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
9475 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
9476
9477 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
9478 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%adv%beg + i - 1)
9479 end do
9480
9481 if (viscous) then
9482
9483# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9484#if defined(MFC_OpenACC)
9485# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9486!$acc loop seq
9487# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9488#elif defined(MFC_OpenMP)
9489# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9490
9491# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9492#endif
9493 do i = 1, 2
9494 re_l(i) = dflt_real
9495 re_r(i) = dflt_real
9496 if (re_size(i) > 0) re_l(i) = 0._wp
9497 if (re_size(i) > 0) re_r(i) = 0._wp
9498
9499# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9500#if defined(MFC_OpenACC)
9501# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9502!$acc loop seq
9503# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9504#elif defined(MFC_OpenMP)
9505# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9506
9507# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9508#endif
9509 do q = 1, re_size(i)
9510 re_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
9511 re_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + re_idx(i, q))/res_gs(i, &
9512 & q) + re_r(i)
9513 end do
9514 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
9515 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
9516 end do
9517 end if
9518
9519 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
9520 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
9521
9522 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
9523 if (hypoelasticity) then
9524
9525# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9526#if defined(MFC_OpenACC)
9527# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9528!$acc loop seq
9529# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9530#elif defined(MFC_OpenMP)
9531# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9532
9533# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9534#endif
9535 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
9536 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
9537 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
9538 end do
9539 g_l = 0._wp; g_r = 0._wp
9540
9541# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9542#if defined(MFC_OpenACC)
9543# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9544!$acc loop seq
9545# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9546#elif defined(MFC_OpenMP)
9547# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9548
9549# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9550#endif
9551 do i = 1, num_fluids
9552 g_l = g_l + alpha_l(i)*gs_rs(i)
9553 g_r = g_r + alpha_r(i)*gs_rs(i)
9554 end do
9555
9556# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9557#if defined(MFC_OpenACC)
9558# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9559!$acc loop seq
9560# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9561#elif defined(MFC_OpenMP)
9562# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9563
9564# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9565#endif
9566 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
9567 ! Elastic contribution to energy if G large enough
9568 if ((g_l > verysmall) .and. (g_r > verysmall)) then
9569 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
9570 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
9571 ! Additional terms in 2D and 3D
9572 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
9573 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
9574 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
9575 end if
9576 end if
9577 end do
9578 end if
9579
9580 ! Hyperelastic stress contribution: strain energy added to total energy
9581 if (hyperelasticity) then
9582
9583# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9584#if defined(MFC_OpenACC)
9585# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9586!$acc loop seq
9587# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9588#elif defined(MFC_OpenMP)
9589# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9590
9591# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9592#endif
9593 do i = 1, num_dims
9594 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
9595 xi_field_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%beg - 1 + i)
9596 end do
9597 g_l = 0._wp; g_r = 0._wp
9598
9599# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9600#if defined(MFC_OpenACC)
9601# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9602!$acc loop seq
9603# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9604#elif defined(MFC_OpenMP)
9605# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9606
9607# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9608#endif
9609 do i = 1, num_fluids
9610 ! Mixture left and right shear modulus
9611 g_l = g_l + alpha_l(i)*gs_rs(i)
9612 g_r = g_r + alpha_r(i)*gs_rs(i)
9613 end do
9614 ! Elastic contribution to energy if G large enough
9615 if (g_l > verysmall .and. g_r > verysmall) then
9616 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
9617 e_r = e_r + g_r*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%end + 1)
9618 end if
9619
9620# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9621#if defined(MFC_OpenACC)
9622# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9623!$acc loop seq
9624# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9625#elif defined(MFC_OpenMP)
9626# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9627
9628# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9629#endif
9630 do i = 1, b_size - 1
9631 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
9632 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
9633 end do
9634 end if
9635
9636 h_l = (e_l + pres_l)/rho_l
9637 h_r = (e_r + pres_r)/rho_r
9638
9639 if (avg_state == 1) then
9640# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9641 rho_avg = sqrt(rho_l*rho_r)
9642# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9643
9644# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9645 vel_avg_rms = 0._wp
9646# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9647
9648# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9649
9650# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9651#if defined(MFC_OpenACC)
9652# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9653!$acc loop seq
9654# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9655#elif defined(MFC_OpenMP)
9656# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9657
9658# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9659#endif
9660# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9661 do i = 1, num_vels
9662# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9663 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
9664# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9665 end do
9666# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9667
9668# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9669 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
9670# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9671
9672# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9673 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
9674# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9675
9676# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9677 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
9678# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9679
9680# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9681 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
9682# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9683
9684# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9685 if (chemistry) then
9686# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9687 eps = 0.001_wp
9688# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9689 call get_species_enthalpies_rt(t_l, h_il)
9690# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9691 call get_species_enthalpies_rt(t_r, h_ir)
9692# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9693 h_il = h_il*gas_constant/molecular_weights*t_l
9694# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9695 h_ir = h_ir*gas_constant/molecular_weights*t_r
9696# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9697 call get_species_specific_heats_r(t_l, cp_il)
9698# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9699 call get_species_specific_heats_r(t_r, cp_ir)
9700# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9701
9702# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9703 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
9704# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9705 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
9706# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9707 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
9708# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9709 if (abs(t_l - t_r) < eps) then
9710# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9711 ! Case when T_L and T_R are very close
9712# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9713 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
9714# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9715 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
9716# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9717 & - gas_constant/molecular_weights(:)))
9718# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9719 else
9720# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9721 ! Normal calculation when T_L and T_R are sufficiently different
9722# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9723 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
9724# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9725 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
9726# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9727 end if
9728# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9729 gamma_avg = cp_avg/cv_avg
9730# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9731
9732# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9733 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
9734# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9735 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
9736# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9737 end if
9738# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9739 end if
9740# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9741
9742# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9743 if (avg_state == 2) then
9744# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9745 rho_avg = 5.e-1_wp*(rho_l + rho_r)
9746# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9747 vel_avg_rms = 0._wp
9748# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9749
9750# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9751#if defined(MFC_OpenACC)
9752# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9753!$acc loop seq
9754# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9755#elif defined(MFC_OpenMP)
9756# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9757
9758# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9759#endif
9760# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9761 do i = 1, num_vels
9762# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9763 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
9764# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9765 end do
9766# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9767
9768# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9769 h_avg = 5.e-1_wp*(h_l + h_r)
9770# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9771 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
9772# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9773 qv_avg = 5.e-1_wp*(qv_l + qv_r)
9774# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9775 end if
9776
9777 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
9778 & c_l, qv_l)
9779
9780 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
9781 & c_r, qv_r)
9782
9783 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
9784 ! variables are placeholders to call the subroutine.
9785 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
9786 & 0._wp, c_avg, qv_avg)
9787
9788 if (viscous) then
9789
9790# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9791#if defined(MFC_OpenACC)
9792# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9793!$acc loop seq
9794# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9795#elif defined(MFC_OpenMP)
9796# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9797
9798# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9799#endif
9800 do i = 1, 2
9801 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
9802 end do
9803 end if
9804
9805 ! Low Mach correction
9806 if (low_mach == 2) then
9807 if (riemann_solver == 1 .or. riemann_solver == 5) then
9808# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9809 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9810# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9811 pcorr = 0._wp
9812# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9813
9814# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9815 if (low_mach == 1) then
9816# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9817 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9818# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9819 end if
9820# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9821 else if (riemann_solver == 2) then
9822# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9823 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9824# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9825 pcorr = 0._wp
9826# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9827
9828# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9829 if (low_mach == 1) then
9830# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9831 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))) &
9832# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9833 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9834# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9835 else if (low_mach == 2) then
9836# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9837 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))))
9838# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9839 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))))
9840# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9841 vel_l(dir_idx(1)) = vel_l_tmp
9842# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9843 vel_r(dir_idx(1)) = vel_r_tmp
9844# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9845 end if
9846# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9847 end if
9848 end if
9849
9850 ! COMPUTING THE DIRECT WAVE SPEEDS
9851 if (wave_speeds == 1) then
9852 if (elasticity) then
9853 ! Elastic wave speed, Rodriguez et al. JCP (2019)
9854 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) &
9855 & ))/rho_l), &
9856 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
9857 & + tau_e_r(dir_idx_tau(1)))/rho_r))
9858 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) &
9859 & ))/rho_r), &
9860 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
9861 & + tau_e_l(dir_idx_tau(1)))/rho_l))
9862 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
9863 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
9864 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
9865 & - vel_r(dir_idx(1))))
9866 else
9867 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
9868 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
9869 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
9870 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
9871 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
9872 end if
9873 else if (wave_speeds == 2) then
9874 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
9875
9876 pres_sr = pres_sl
9877
9878 ! Low Mach correction: Thornber et al. JCP (2008)
9879 ms_l = max(1._wp, &
9880 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
9881 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
9882 ms_r = max(1._wp, &
9883 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
9884 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
9885
9886 s_l = vel_l(dir_idx(1)) - c_l*ms_l
9887 s_r = vel_r(dir_idx(1)) + c_r*ms_r
9888
9889 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
9890 end if
9891
9892 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
9893 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
9894
9895 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
9896 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
9897 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
9898 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
9899 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
9900
9901 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
9902 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
9903 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
9904
9905 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
9906 xi_mp = -min(0._wp, sign(1._wp, s_l))
9907 xi_pp = max(0._wp, sign(1._wp, s_r))
9908
9909 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 &
9910 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
9911 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
9912 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
9913 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
9914
9915 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))
9916
9917 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 &
9918 & - vel_r(dir_idx(1)))
9919
9920 ! Low Mach correction
9921 if (low_mach == 1) then
9922 if (riemann_solver == 1 .or. riemann_solver == 5) then
9923# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9924 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9925# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9926 pcorr = 0._wp
9927# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9928
9929# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9930 if (low_mach == 1) then
9931# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9932 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9933# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9934 end if
9935# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9936 else if (riemann_solver == 2) then
9937# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9938 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9939# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9940 pcorr = 0._wp
9941# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9942
9943# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9944 if (low_mach == 1) then
9945# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9946 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))) &
9947# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9948 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
9949# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9950 else if (low_mach == 2) then
9951# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9952 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))))
9953# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9954 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))))
9955# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9956 vel_l(dir_idx(1)) = vel_l_tmp
9957# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9958 vel_r(dir_idx(1)) = vel_r_tmp
9959# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9960 end if
9961# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9962 end if
9963 else
9964 pcorr = 0._wp
9965 end if
9966
9967 ! COMPUTING FLUXES MASS FLUX.
9968
9969# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9970#if defined(MFC_OpenACC)
9971# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9972!$acc loop seq
9973# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9974#elif defined(MFC_OpenMP)
9975# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9976
9977# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9978#endif
9979 do i = 1, eqn_idx%cont%end
9980 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
9981 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
9982 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
9983 end do
9984
9985 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
9986
9987# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9988#if defined(MFC_OpenACC)
9989# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9990!$acc loop seq
9991# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9992#elif defined(MFC_OpenMP)
9993# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9994
9995# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9996#endif
9997 do i = 1, num_dims
9998 flux_rsx_vf(j, k, l, &
9999 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
10000 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
10001 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
10002 & *dir_flg(dir_idx(i))*pcorr
10003 end do
10004
10005 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
10006 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
10007
10008 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
10009 if (elasticity) then
10010 flux_ene_e = 0._wp
10011
10012# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10013#if defined(MFC_OpenACC)
10014# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10015!$acc loop seq
10016# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10017#elif defined(MFC_OpenMP)
10018# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10019
10020# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10021#endif
10022 do i = 1, num_dims
10023 ! MOMENTUM ELASTIC FLUX.
10024 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
10025 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
10026 & - xi_p*tau_e_r(dir_idx_tau(i))
10027 ! ENERGY ELASTIC FLUX.
10028 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
10029 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
10030 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
10031 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
10032 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
10033 end do
10034 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
10035 end if
10036
10037 ! VOLUME FRACTION FLUX.
10038
10039# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10040#if defined(MFC_OpenACC)
10041# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10042!$acc loop seq
10043# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10044#elif defined(MFC_OpenMP)
10045# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10046
10047# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10048#endif
10049 do i = eqn_idx%adv%beg, eqn_idx%adv%end
10050 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
10051 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k + 1, l, i)*s_s
10052 end do
10053
10054 ! Advection velocity source: interface velocity for volume fraction transport
10055
10056# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10057#if defined(MFC_OpenACC)
10058# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10059!$acc loop seq
10060# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10061#elif defined(MFC_OpenMP)
10062# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10063
10064# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10065#endif
10066 do i = 1, num_dims
10067 vel_src_rsx_vf(j, k, l, &
10068 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
10069 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
10070 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
10071 end do
10072
10073 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
10074 ! energy flux
10075
10076# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10077#if defined(MFC_OpenACC)
10078# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10079!$acc loop seq
10080# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10081#elif defined(MFC_OpenMP)
10082# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10083
10084# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10085#endif
10086 do i = 1, num_fluids
10087 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
10088 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
10089 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
10090 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
10091 & + pres_r)
10092
10093 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
10094 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
10095 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
10096 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
10097 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
10098 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
10099 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
10100 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
10101 & i + eqn_idx%adv%beg - 1))
10102 end do
10103
10104 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
10105
10106 ! HYPOELASTIC STRESS EVOLUTION FLUX.
10107 if (hypoelasticity) then
10108
10109# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10110#if defined(MFC_OpenACC)
10111# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10112!$acc loop seq
10113# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10114#elif defined(MFC_OpenMP)
10115# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10116
10117# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10118#endif
10119 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
10120 flux_rsx_vf(j, k, l, &
10121 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
10122 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
10123 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
10124 end do
10125 end if
10126
10127 ! Hyperelastic reference map flux for material deformation tracking
10128 if (hyperelasticity) then
10129
10130# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10131#if defined(MFC_OpenACC)
10132# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10133!$acc loop seq
10134# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10135#elif defined(MFC_OpenMP)
10136# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10137
10138# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10139#endif
10140 do i = 1, num_dims
10141 flux_rsx_vf(j, k, l, &
10142 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
10143 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
10144 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
10145 end do
10146 end if
10147
10148 ! COLOR FUNCTION FLUX
10149 if (surface_tension) then
10150 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
10151 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%c))*s_s
10152 end if
10153
10154 ! Geometrical source flux for cylindrical coordinates
10155# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10156 if (cyl_coord) then
10157 ! Substituting the advective flux into the inviscid geometrical source flux
10158
10159# 2173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10160#if defined(MFC_OpenACC)
10161# 2173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10162!$acc loop seq
10163# 2173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10164#elif defined(MFC_OpenMP)
10165# 2173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10166
10167# 2173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10168#endif
10169 do i = 1, eqn_idx%E
10170 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
10171 end do
10172
10173# 2177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10174#if defined(MFC_OpenACC)
10175# 2177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10176!$acc loop seq
10177# 2177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10178#elif defined(MFC_OpenMP)
10179# 2177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10180
10181# 2177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10182#endif
10183 do i = eqn_idx%int_en%beg, eqn_idx%int_en%end
10184 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
10185 end do
10186 ! Recalculating the radial momentum geometric source flux
10187 flux_gsrc_rsx_vf(j, k, l, &
10188 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
10189 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
10190 ! Geometrical source of the void fraction(s) is zero
10191
10192# 2186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10193#if defined(MFC_OpenACC)
10194# 2186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10195!$acc loop seq
10196# 2186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10197#elif defined(MFC_OpenMP)
10198# 2186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10199
10200# 2186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10201#endif
10202 do i = eqn_idx%adv%beg, eqn_idx%adv%end
10203 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
10204 end do
10205 end if
10206# 2192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10207# 2205 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10208 end do
10209 end do
10210 end do
10211
10212# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10213#if defined(MFC_OpenACC)
10214# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10215!$acc end parallel loop
10216# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10217#elif defined(MFC_OpenMP)
10218# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10219
10220# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10221!$omp end target teams loop
10222# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10223#endif
10224 else if (model_eqns == 4) then
10225 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
10226
10227# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10228
10229# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10230#if defined(MFC_OpenACC)
10231# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10232!$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)
10233# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10234#elif defined(MFC_OpenMP)
10235# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10236
10237# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10238
10239# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10240
10241# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10242!$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)
10243# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10244#endif
10245# 2220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10246 do l = is3%beg, is3%end
10247 do k = is1%beg, is1%end
10248 do j = is2%beg, is2%end
10249 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10250 rho_l = 0._wp; rho_r = 0._wp
10251 gamma_l = 0._wp; gamma_r = 0._wp
10252 pi_inf_l = 0._wp; pi_inf_r = 0._wp
10253 qv_l = 0._wp; qv_r = 0._wp
10254
10255
10256# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10257#if defined(MFC_OpenACC)
10258# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10259!$acc loop seq
10260# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10261#elif defined(MFC_OpenMP)
10262# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10263
10264# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10265#endif
10266 do i = 1, eqn_idx%cont%end
10267 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
10268 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
10269 end do
10270
10271
10272# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10273#if defined(MFC_OpenACC)
10274# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10275!$acc loop seq
10276# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10277#elif defined(MFC_OpenMP)
10278# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10279
10280# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10281#endif
10282 do i = 1, num_dims
10283 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
10284 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
10285 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
10286 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
10287 end do
10288
10289
10290# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10291#if defined(MFC_OpenACC)
10292# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10293!$acc loop seq
10294# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10295#elif defined(MFC_OpenMP)
10296# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10297
10298# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10299#endif
10300 do i = 1, num_fluids
10301 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
10302 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
10303 end do
10304
10305# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10306#if defined(MFC_OpenACC)
10307# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10308!$acc loop seq
10309# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10310#elif defined(MFC_OpenMP)
10311# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10312
10313# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10314#endif
10315 do i = 1, num_fluids
10316 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
10317 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
10318 end do
10319
10320
10321# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10322#if defined(MFC_OpenACC)
10323# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10324!$acc loop seq
10325# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10326#elif defined(MFC_OpenMP)
10327# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10328
10329# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10330#endif
10331 do i = 1, num_fluids
10332 rho_l = rho_l + alpha_rho_l(i)
10333 gamma_l = gamma_l + alpha_l(i)*gammas(i)
10334 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
10335 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
10336
10337 rho_r = rho_r + alpha_rho_r(i)
10338 gamma_r = gamma_r + alpha_r(i)*gammas(i)
10339 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
10340 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
10341 end do
10342
10343 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
10344 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
10345
10346 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
10347 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
10348
10349 h_l = (e_l + pres_l)/rho_l
10350 h_r = (e_r + pres_r)/rho_r
10351
10352 if (avg_state == 1) then
10353# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10354 rho_avg = sqrt(rho_l*rho_r)
10355# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10356
10357# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10358 vel_avg_rms = 0._wp
10359# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10360
10361# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10362
10363# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10364#if defined(MFC_OpenACC)
10365# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10366!$acc loop seq
10367# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10368#elif defined(MFC_OpenMP)
10369# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10370
10371# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10372#endif
10373# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10374 do i = 1, num_vels
10375# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10376 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
10377# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10378 end do
10379# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10380
10381# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10382 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
10383# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10384
10385# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10386 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
10387# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10388
10389# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10390 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
10391# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10392
10393# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10394 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
10395# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10396
10397# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10398 if (chemistry) then
10399# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10400 eps = 0.001_wp
10401# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10402 call get_species_enthalpies_rt(t_l, h_il)
10403# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10404 call get_species_enthalpies_rt(t_r, h_ir)
10405# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10406 h_il = h_il*gas_constant/molecular_weights*t_l
10407# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10408 h_ir = h_ir*gas_constant/molecular_weights*t_r
10409# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10410 call get_species_specific_heats_r(t_l, cp_il)
10411# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10412 call get_species_specific_heats_r(t_r, cp_ir)
10413# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10414
10415# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10416 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
10417# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10418 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
10419# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10420 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
10421# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10422 if (abs(t_l - t_r) < eps) then
10423# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10424 ! Case when T_L and T_R are very close
10425# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10426 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
10427# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10428 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
10429# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10430 & - gas_constant/molecular_weights(:)))
10431# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10432 else
10433# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10434 ! Normal calculation when T_L and T_R are sufficiently different
10435# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10436 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
10437# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10438 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
10439# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10440 end if
10441# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10442 gamma_avg = cp_avg/cv_avg
10443# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10444
10445# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10446 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
10447# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10448 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
10449# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10450 end if
10451# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10452 end if
10453# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10454
10455# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10456 if (avg_state == 2) then
10457# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10458 rho_avg = 5.e-1_wp*(rho_l + rho_r)
10459# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10460 vel_avg_rms = 0._wp
10461# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10462
10463# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10464#if defined(MFC_OpenACC)
10465# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10466!$acc loop seq
10467# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10468#elif defined(MFC_OpenMP)
10469# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10470
10471# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10472#endif
10473# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10474 do i = 1, num_vels
10475# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10476 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
10477# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10478 end do
10479# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10480
10481# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10482 h_avg = 5.e-1_wp*(h_l + h_r)
10483# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10484 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
10485# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10486 qv_avg = 5.e-1_wp*(qv_l + qv_r)
10487# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10488 end if
10489
10490 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
10491 & c_l, qv_l)
10492
10493 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
10494 & c_r, qv_r)
10495
10496 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
10497 ! variables are placeholders to call the subroutine.
10498
10499 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
10500 & 0._wp, c_avg, qv_avg)
10501
10502 if (wave_speeds == 1) then
10503 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
10504 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
10505
10506 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
10507 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
10508 & - rho_r*(s_r - vel_r(dir_idx(1))))
10509 else if (wave_speeds == 2) then
10510 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
10511
10512 pres_sr = pres_sl
10513
10514 ! Low Mach correction: Thornber et al. JCP (2008)
10515 ms_l = max(1._wp, &
10516 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
10517 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
10518 ms_r = max(1._wp, &
10519 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
10520 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
10521
10522 s_l = vel_l(dir_idx(1)) - c_l*ms_l
10523 s_r = vel_r(dir_idx(1)) + c_r*ms_r
10524
10525 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
10526 end if
10527
10528 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
10529 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
10530
10531 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
10532 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
10533 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
10534 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
10535 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
10536
10537 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
10538 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
10539 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
10540
10541
10542# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10543#if defined(MFC_OpenACC)
10544# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10545!$acc loop seq
10546# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10547#elif defined(MFC_OpenMP)
10548# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10549
10550# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10551#endif
10552 do i = 1, eqn_idx%cont%end
10553 flux_rsx_vf(j, k, l, &
10554 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
10555 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
10556 end do
10557
10558 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
10559
10560# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10561#if defined(MFC_OpenACC)
10562# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10563!$acc loop seq
10564# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10565#elif defined(MFC_OpenMP)
10566# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10567
10568# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10569#endif
10570 do i = 1, num_dims
10571 flux_rsx_vf(j, k, l, &
10572 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
10573 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
10574 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
10575 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
10576 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
10577 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
10578 end do
10579
10580 if (bubbles_euler) then
10581 ! Put p_tilde in
10582
10583# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10584#if defined(MFC_OpenACC)
10585# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10586!$acc loop seq
10587# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10588#elif defined(MFC_OpenMP)
10589# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10590
10591# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10592#endif
10593 do i = 1, num_dims
10594 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
10595 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
10596 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
10597 end do
10598 end if
10599
10600 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
10601
10602
10603# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10604#if defined(MFC_OpenACC)
10605# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10606!$acc loop seq
10607# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10608#elif defined(MFC_OpenMP)
10609# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10610
10611# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10612#endif
10613 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
10614 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
10615 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
10616 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
10617 end do
10618
10619 ! Advection velocity source: interface velocity for volume fraction transport
10620
10621# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10622#if defined(MFC_OpenACC)
10623# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10624!$acc loop seq
10625# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10626#elif defined(MFC_OpenMP)
10627# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10628
10629# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10630#endif
10631 do i = 1, num_dims
10632 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
10633 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
10634 end do
10635
10636 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
10637
10638 ! Add advection flux for bubble variables
10639 if (bubbles_euler) then
10640
10641# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10642#if defined(MFC_OpenACC)
10643# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10644!$acc loop seq
10645# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10646#elif defined(MFC_OpenMP)
10647# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10648
10649# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10650#endif
10651 do i = eqn_idx%bub%beg, eqn_idx%bub%end
10652 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
10653 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
10654 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k + 1, l, &
10655 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
10656 end do
10657 end if
10658
10659 ! Geometrical source flux for cylindrical coordinates
10660
10661# 2390 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10662 if (cyl_coord) then
10663 ! Substituting the advective flux into the inviscid geometrical source flux
10664
10665# 2392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10666#if defined(MFC_OpenACC)
10667# 2392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10668!$acc loop seq
10669# 2392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10670#elif defined(MFC_OpenMP)
10671# 2392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10672
10673# 2392 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10674#endif
10675 do i = 1, eqn_idx%E
10676 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
10677 end do
10678 ! Recalculating the radial momentum geometric source flux
10679 flux_gsrc_rsx_vf(j, k, l, &
10680 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
10681 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
10682 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
10683 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
10684 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
10685 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
10686 ! Geometrical source of the void fraction(s) is zero
10687
10688# 2405 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10689#if defined(MFC_OpenACC)
10690# 2405 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10691!$acc loop seq
10692# 2405 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10693#elif defined(MFC_OpenMP)
10694# 2405 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10695
10696# 2405 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10697#endif
10698 do i = eqn_idx%adv%beg, eqn_idx%adv%end
10699 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
10700 end do
10701 end if
10702# 2411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10703# 2427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10704 end do
10705 end do
10706 end do
10707
10708# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10709#if defined(MFC_OpenACC)
10710# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10711!$acc end parallel loop
10712# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10713#elif defined(MFC_OpenMP)
10714# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10715
10716# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10717!$omp end target teams loop
10718# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10719#endif
10720 else if (model_eqns == 2 .and. bubbles_euler) then
10721 ! 5-equation model with Euler-Euler bubble dynamics
10722
10723# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10724
10725# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10726#if defined(MFC_OpenACC)
10727# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10728!$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)
10729# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10730#elif defined(MFC_OpenMP)
10731# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10732
10733# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10734
10735# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10736
10737# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10738!$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)
10739# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10740#endif
10741# 2441 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10742 do l = is3%beg, is3%end
10743 do k = is1%beg, is1%end
10744 do j = is2%beg, is2%end
10745 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10746 rho_l = 0._wp; rho_r = 0._wp
10747 gamma_l = 0._wp; gamma_r = 0._wp
10748 pi_inf_l = 0._wp; pi_inf_r = 0._wp
10749 qv_l = 0._wp; qv_r = 0._wp
10750
10751
10752# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10753#if defined(MFC_OpenACC)
10754# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10755!$acc loop seq
10756# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10757#elif defined(MFC_OpenMP)
10758# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10759
10760# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10761#endif
10762 do i = 1, num_fluids
10763 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
10764 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
10765 end do
10766
10767 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10768
10769
10770# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10771#if defined(MFC_OpenACC)
10772# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10773!$acc loop seq
10774# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10775#elif defined(MFC_OpenMP)
10776# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10777
10778# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10779#endif
10780 do i = 1, num_dims
10781 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
10782 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
10783 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
10784 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
10785 end do
10786
10787 ! Retain this in the refactor
10788 if (mpp_lim .and. (num_fluids > 2)) then
10789
10790# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10791#if defined(MFC_OpenACC)
10792# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10793!$acc loop seq
10794# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10795#elif defined(MFC_OpenMP)
10796# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10797
10798# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10799#endif
10800 do i = 1, num_fluids
10801 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
10802 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
10803 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
10804 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
10805 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
10806 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
10807 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
10808 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
10809 end do
10810 else if (num_fluids > 2) then
10811
10812# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10813#if defined(MFC_OpenACC)
10814# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10815!$acc loop seq
10816# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10817#elif defined(MFC_OpenMP)
10818# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10819
10820# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10821#endif
10822 do i = 1, num_fluids - 1
10823 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
10824 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
10825 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
10826 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
10827 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
10828 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
10829 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
10830 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
10831 end do
10832 else
10833 rho_l = ql_prim_rsx_vf(j, k, l, 1)
10834 gamma_l = gammas(1)
10835 pi_inf_l = pi_infs(1)
10836 qv_l = qvs(1)
10837 rho_r = qr_prim_rsx_vf(j, k + 1, l, 1)
10838 gamma_r = gammas(1)
10839 pi_inf_r = pi_infs(1)
10840 qv_r = qvs(1)
10841 end if
10842
10843 if (viscous) then
10844 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
10845
10846# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10847#if defined(MFC_OpenACC)
10848# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10849!$acc loop seq
10850# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10851#elif defined(MFC_OpenMP)
10852# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10853
10854# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10855#endif
10856 do i = 1, 2
10857 re_l(i) = dflt_real
10858 re_r(i) = dflt_real
10859
10860 if (re_size(i) > 0) re_l(i) = 0._wp
10861 if (re_size(i) > 0) re_r(i) = 0._wp
10862
10863
10864# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10865#if defined(MFC_OpenACC)
10866# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10867!$acc loop seq
10868# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10869#elif defined(MFC_OpenMP)
10870# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10871
10872# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10873#endif
10874 do q = 1, re_size(i)
10875 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
10876 & q)))/res_gs(i, q) + re_l(i)
10877 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + re_idx(i, &
10878 & q)))/res_gs(i, q) + re_r(i)
10879 end do
10880
10881 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
10882 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
10883 end do
10884 end if
10885 end if
10886
10887 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
10888 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
10889
10890 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
10891 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
10892
10893 h_l = (e_l + pres_l)/rho_l
10894 h_r = (e_r + pres_r)/rho_r
10895
10896 if (avg_state == 2) then
10897
10898# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10899#if defined(MFC_OpenACC)
10900# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10901!$acc loop seq
10902# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10903#elif defined(MFC_OpenMP)
10904# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10905
10906# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10907#endif
10908 do i = 1, nb
10909 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
10910 r0_r(i) = qr_prim_rsx_vf(j, k + 1, l, rs(i))
10911
10912 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
10913 v0_r(i) = qr_prim_rsx_vf(j, k + 1, l, vs(i))
10914 if (.not. polytropic .and. .not. qbmm) then
10915 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
10916 p0_r(i) = qr_prim_rsx_vf(j, k + 1, l, ps(i))
10917 end if
10918 end do
10919
10920 if (.not. qbmm) then
10921 if (adv_n) then
10922 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
10923 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%n)
10924 else
10925 nbub_l = 0._wp
10926 nbub_r = 0._wp
10927
10928# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10929#if defined(MFC_OpenACC)
10930# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10931!$acc loop seq
10932# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10933#elif defined(MFC_OpenMP)
10934# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10935
10936# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10937#endif
10938 do i = 1, nb
10939 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
10940 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
10941 end do
10942
10943 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
10944 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k + 1, l, &
10945 & eqn_idx%E + num_fluids)/nbub_r
10946 end if
10947 else
10948 ! nb stored in 0th moment of first R0 bin in variable conversion module
10949 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
10950 nbub_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%bub%beg)
10951 end if
10952
10953
10954# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10955#if defined(MFC_OpenACC)
10956# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10957!$acc loop seq
10958# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10959#elif defined(MFC_OpenMP)
10960# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10961
10962# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10963#endif
10964 do i = 1, nb
10965 if (.not. qbmm) then
10966 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
10967 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
10968 end if
10969 end do
10970
10971 if (qbmm) then
10972 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
10973 pbwr3rbar = mom_sp_rsx_vf(j, k + 1, l, 4)
10974
10975 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
10976 r3rbar = mom_sp_rsx_vf(j, k + 1, l, 1)
10977
10978 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
10979 r3v2rbar = mom_sp_rsx_vf(j, k + 1, l, 3)
10980 else
10981 pbwr3lbar = 0._wp
10982 pbwr3rbar = 0._wp
10983
10984 r3lbar = 0._wp
10985 r3rbar = 0._wp
10986
10987 r3v2lbar = 0._wp
10988 r3v2rbar = 0._wp
10989
10990
10991# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10992#if defined(MFC_OpenACC)
10993# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10994!$acc loop seq
10995# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10996#elif defined(MFC_OpenMP)
10997# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10998
10999# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11000#endif
11001 do i = 1, nb
11002 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
11003 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
11004
11005 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
11006 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
11007
11008 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
11009 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
11010 end do
11011 end if
11012
11013 rho_avg = 5.e-1_wp*(rho_l + rho_r)
11014 h_avg = 5.e-1_wp*(h_l + h_r)
11015 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
11016 qv_avg = 5.e-1_wp*(qv_l + qv_r)
11017 vel_avg_rms = 0._wp
11018
11019
11020# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11021#if defined(MFC_OpenACC)
11022# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11023!$acc loop seq
11024# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11025#elif defined(MFC_OpenMP)
11026# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11027
11028# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11029#endif
11030 do i = 1, num_dims
11031 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
11032 end do
11033 end if
11034
11035 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
11036 & c_l, qv_l)
11037
11038 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
11039 & c_r, qv_r)
11040
11041 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
11042 ! variables are placeholders to call the subroutine.
11043 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
11044 & 0._wp, c_avg, qv_avg)
11045
11046 if (viscous) then
11047
11048# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11049#if defined(MFC_OpenACC)
11050# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11051!$acc loop seq
11052# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11053#elif defined(MFC_OpenMP)
11054# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11055
11056# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11057#endif
11058 do i = 1, 2
11059 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
11060 end do
11061 end if
11062
11063 ! Low Mach correction
11064 if (low_mach == 2) then
11065 if (riemann_solver == 1 .or. riemann_solver == 5) then
11066# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11067 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11068# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11069 pcorr = 0._wp
11070# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11071
11072# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11073 if (low_mach == 1) then
11074# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11075 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
11076# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11077 end if
11078# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11079 else if (riemann_solver == 2) then
11080# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11081 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11082# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11083 pcorr = 0._wp
11084# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11085
11086# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11087 if (low_mach == 1) then
11088# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11089 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))) &
11090# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11091 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
11092# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11093 else if (low_mach == 2) then
11094# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11095 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))))
11096# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11097 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))))
11098# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11099 vel_l(dir_idx(1)) = vel_l_tmp
11100# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11101 vel_r(dir_idx(1)) = vel_r_tmp
11102# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11103 end if
11104# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11105 end if
11106 end if
11107
11108 if (wave_speeds == 1) then
11109 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
11110 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
11111
11112 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
11113 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
11114 & - rho_r*(s_r - vel_r(dir_idx(1))))
11115 else if (wave_speeds == 2) then
11116 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
11117
11118 pres_sr = pres_sl
11119
11120 ! Low Mach correction: Thornber et al. JCP (2008)
11121 ms_l = max(1._wp, &
11122 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
11123 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
11124 ms_r = max(1._wp, &
11125 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
11126 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
11127
11128 s_l = vel_l(dir_idx(1)) - c_l*ms_l
11129 s_r = vel_r(dir_idx(1)) + c_r*ms_r
11130
11131 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
11132 end if
11133
11134 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
11135 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
11136
11137 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
11138 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
11139 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
11140 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
11141 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
11142
11143 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
11144 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
11145 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
11146
11147 ! Low Mach correction
11148 if (low_mach == 1) then
11149 if (riemann_solver == 1 .or. riemann_solver == 5) then
11150# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11151 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11152# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11153 pcorr = 0._wp
11154# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11155
11156# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11157 if (low_mach == 1) then
11158# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11159 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
11160# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11161 end if
11162# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11163 else if (riemann_solver == 2) then
11164# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11165 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11166# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11167 pcorr = 0._wp
11168# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11169
11170# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11171 if (low_mach == 1) then
11172# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11173 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))) &
11174# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11175 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
11176# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11177 else if (low_mach == 2) then
11178# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11179 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))))
11180# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11181 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))))
11182# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11183 vel_l(dir_idx(1)) = vel_l_tmp
11184# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11185 vel_r(dir_idx(1)) = vel_r_tmp
11186# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11187 end if
11188# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11189 end if
11190 else
11191 pcorr = 0._wp
11192 end if
11193
11194
11195# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11196#if defined(MFC_OpenACC)
11197# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11198!$acc loop seq
11199# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11200#elif defined(MFC_OpenMP)
11201# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11202
11203# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11204#endif
11205 do i = 1, eqn_idx%cont%end
11206 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
11207 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
11208 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
11209 end do
11210
11211 if (bubbles_euler .and. (num_fluids > 1)) then
11212 ! Kill mass transport @ gas density
11213 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
11214 end if
11215
11216 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
11217
11218 ! Include p_tilde
11219
11220 if (avg_state == 2) then
11221 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
11222 pres_l = pres_l - alpha_l(num_fluids)*pres_l
11223 else
11224 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
11225 end if
11226
11227 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
11228 pres_r = pres_r - alpha_r(num_fluids)*pres_r
11229 else
11230 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
11231 end if
11232 end if
11233
11234
11235# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11236#if defined(MFC_OpenACC)
11237# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11238!$acc loop seq
11239# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11240#elif defined(MFC_OpenMP)
11241# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11242
11243# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11244#endif
11245 do i = 1, num_dims
11246 flux_rsx_vf(j, k, l, &
11247 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
11248 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
11249 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
11250 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
11251 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
11252 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
11253 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
11254 end do
11255
11256 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
11257 flux_rsx_vf(j, k, l, &
11258 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
11259 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
11260 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
11261 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
11262 & *pcorr*s_s
11263
11264 ! Volume fraction flux
11265
11266# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11267#if defined(MFC_OpenACC)
11268# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11269!$acc loop seq
11270# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11271#elif defined(MFC_OpenMP)
11272# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11273
11274# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11275#endif
11276 do i = eqn_idx%adv%beg, eqn_idx%adv%end
11277 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
11278 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
11279 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
11280 end do
11281
11282 ! Advection velocity source: interface velocity for volume fraction transport
11283
11284# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11285#if defined(MFC_OpenACC)
11286# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11287!$acc loop seq
11288# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11289#elif defined(MFC_OpenMP)
11290# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11291
11292# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11293#endif
11294 do i = 1, num_dims
11295 vel_src_rsx_vf(j, k, l, &
11296 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
11297 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
11298
11299 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
11300 end do
11301
11302 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
11303
11304 ! Add advection flux for bubble variables
11305
11306# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11307#if defined(MFC_OpenACC)
11308# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11309!$acc loop seq
11310# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11311#elif defined(MFC_OpenMP)
11312# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11313
11314# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11315#endif
11316 do i = eqn_idx%bub%beg, eqn_idx%bub%end
11317 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
11318 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
11319 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k + 1, l, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
11320 end do
11321
11322 if (qbmm) then
11323 flux_rsx_vf(j, k, l, &
11324 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
11325 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
11326 end if
11327
11328 if (adv_n) then
11329 flux_rsx_vf(j, k, l, &
11330 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
11331 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
11332 end if
11333
11334 ! Geometrical source flux for cylindrical coordinates
11335# 2785 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11336 if (cyl_coord) then
11337 ! Substituting the advective flux into the inviscid geometrical source flux
11338
11339# 2787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11340#if defined(MFC_OpenACC)
11341# 2787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11342!$acc loop seq
11343# 2787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11344#elif defined(MFC_OpenMP)
11345# 2787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11346
11347# 2787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11348#endif
11349 do i = 1, eqn_idx%E
11350 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
11351 end do
11352 ! Recalculating the radial momentum geometric source flux
11353 flux_gsrc_rsx_vf(j, k, l, &
11354 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
11355 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
11356 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
11357 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
11358 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
11359 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
11360 ! Geometrical source of the void fraction(s) is zero
11361
11362# 2800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11363#if defined(MFC_OpenACC)
11364# 2800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11365!$acc loop seq
11366# 2800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11367#elif defined(MFC_OpenMP)
11368# 2800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11369
11370# 2800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11371#endif
11372 do i = eqn_idx%adv%beg, eqn_idx%adv%end
11373 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
11374 end do
11375 end if
11376# 2806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11377# 2823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11378 end do
11379 end do
11380 end do
11381
11382# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11383#if defined(MFC_OpenACC)
11384# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11385!$acc end parallel loop
11386# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11387#elif defined(MFC_OpenMP)
11388# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11389
11390# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11391!$omp end target teams loop
11392# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11393#endif
11394 else
11395 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
11396
11397# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11398
11399# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11400#if defined(MFC_OpenACC)
11401# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11402!$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)
11403# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11404#elif defined(MFC_OpenMP)
11405# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11406
11407# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11408
11409# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11410
11411# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11412!$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)
11413# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11414#endif
11415# 2838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11416 do l = is3%beg, is3%end
11417 do k = is1%beg, is1%end
11418 do j = is2%beg, is2%end
11419 vel_l_rms = 0._wp; vel_r_rms = 0._wp
11420 rho_l = 0._wp; rho_r = 0._wp
11421 gamma_l = 0._wp; gamma_r = 0._wp
11422 pi_inf_l = 0._wp; pi_inf_r = 0._wp
11423 qv_l = 0._wp; qv_r = 0._wp
11424 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
11425
11426
11427# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11428#if defined(MFC_OpenACC)
11429# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11430!$acc loop seq
11431# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11432#elif defined(MFC_OpenMP)
11433# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11434
11435# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11436#endif
11437 do i = 1, num_fluids
11438 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
11439 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
11440 end do
11441
11442
11443# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11444#if defined(MFC_OpenACC)
11445# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11446!$acc loop seq
11447# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11448#elif defined(MFC_OpenMP)
11449# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11450
11451# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11452#endif
11453 do i = 1, num_dims
11454 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
11455 vel_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + i)
11456 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
11457 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
11458 end do
11459
11460 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
11461 pres_r = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
11462
11463 ! Change this by splitting it into the cases present in the bubbles_euler
11464 if (mpp_lim) then
11465
11466# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11467#if defined(MFC_OpenACC)
11468# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11469!$acc loop seq
11470# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11471#elif defined(MFC_OpenMP)
11472# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11473
11474# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11475#endif
11476 do i = 1, num_fluids
11477 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
11478 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
11479 & eqn_idx%E + i)), 1._wp)
11480 qr_prim_rsx_vf(j, k + 1, l, i) = max(0._wp, qr_prim_rsx_vf(j, k + 1, l, i))
11481 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = min(max(0._wp, &
11482 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)), 1._wp)
11483 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
11484 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
11485 end do
11486
11487
11488# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11489#if defined(MFC_OpenACC)
11490# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11491!$acc loop seq
11492# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11493#elif defined(MFC_OpenMP)
11494# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11495
11496# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11497#endif
11498 do i = 1, num_fluids
11499 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
11500 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
11501 qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i) = qr_prim_rsx_vf(j, k + 1, l, &
11502 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
11503 end do
11504 end if
11505
11506
11507# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11508#if defined(MFC_OpenACC)
11509# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11510!$acc loop seq
11511# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11512#elif defined(MFC_OpenMP)
11513# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11514
11515# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11516#endif
11517 do i = 1, num_fluids
11518 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
11519 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
11520 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
11521 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
11522
11523 rho_r = rho_r + qr_prim_rsx_vf(j, k + 1, l, i)
11524 gamma_r = gamma_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*gammas(i)
11525 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)*pi_infs(i)
11526 qv_r = qv_r + qr_prim_rsx_vf(j, k + 1, l, i)*qvs(i)
11527 end do
11528
11529 re_max = 0
11530 if (re_size(1) > 0) re_max = 1
11531 if (re_size(2) > 0) re_max = 2
11532
11533 if (viscous) then
11534
11535# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11536#if defined(MFC_OpenACC)
11537# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11538!$acc loop seq
11539# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11540#elif defined(MFC_OpenMP)
11541# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11542
11543# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11544#endif
11545 do i = 1, re_max
11546 re_l(i) = 0._wp
11547 re_r(i) = 0._wp
11548
11549
11550# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11551#if defined(MFC_OpenACC)
11552# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11553!$acc loop seq
11554# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11555#elif defined(MFC_OpenMP)
11556# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11557
11558# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11559#endif
11560 do q = 1, re_size(i)
11561 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
11562 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
11563 end do
11564
11565 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
11566 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
11567 end do
11568 end if
11569
11570 if (chemistry) then
11571 c_sum_yi_phi = 0.0_wp
11572
11573# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11574#if defined(MFC_OpenACC)
11575# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11576!$acc loop seq
11577# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11578#elif defined(MFC_OpenMP)
11579# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11580
11581# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11582#endif
11583 do i = eqn_idx%species%beg, eqn_idx%species%end
11584 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
11585 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k + 1, l, i)
11586 end do
11587
11588 call get_mixture_molecular_weight(ys_l, mw_l)
11589 call get_mixture_molecular_weight(ys_r, mw_r)
11590
11591# 2937 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11592 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
11593 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
11594# 2940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11595
11596 r_gas_l = gas_constant/mw_l
11597 r_gas_r = gas_constant/mw_r
11598
11599 t_l = pres_l/rho_l/r_gas_l
11600 t_r = pres_r/rho_r/r_gas_r
11601
11602 call get_species_specific_heats_r(t_l, cp_il)
11603 call get_species_specific_heats_r(t_r, cp_ir)
11604
11605 if (chem_params%gamma_method == 1) then
11606 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
11607 gamma_il = cp_il/(cp_il - 1.0_wp)
11608 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
11609
11610 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
11611 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
11612 else if (chem_params%gamma_method == 2) then
11613 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
11614 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
11615 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
11616 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
11617 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
11618
11619 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
11620 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
11621 end if
11622
11623 call get_mixture_energy_mass(t_l, ys_l, e_l)
11624 call get_mixture_energy_mass(t_r, ys_r, e_r)
11625
11626 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
11627 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
11628 h_l = (e_l + pres_l)/rho_l
11629 h_r = (e_r + pres_r)/rho_r
11630 else
11631 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
11632 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
11633
11634 h_l = (e_l + pres_l)/rho_l
11635 h_r = (e_r + pres_r)/rho_r
11636 end if
11637
11638 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
11639 if (hypoelasticity) then
11640
11641# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11642#if defined(MFC_OpenACC)
11643# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11644!$acc loop seq
11645# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11646#elif defined(MFC_OpenMP)
11647# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11648
11649# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11650#endif
11651 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
11652 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
11653 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
11654 end do
11655 g_l = 0._wp
11656 g_r = 0._wp
11657
11658# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11659#if defined(MFC_OpenACC)
11660# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11661!$acc loop seq
11662# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11663#elif defined(MFC_OpenMP)
11664# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11665
11666# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11667#endif
11668 do i = 1, num_fluids
11669 g_l = g_l + alpha_l(i)*gs_rs(i)
11670 g_r = g_r + alpha_r(i)*gs_rs(i)
11671 end do
11672
11673# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11674#if defined(MFC_OpenACC)
11675# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11676!$acc loop seq
11677# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11678#elif defined(MFC_OpenMP)
11679# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11680
11681# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11682#endif
11683 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
11684 ! Elastic contribution to energy if G large enough
11685 if ((g_l > verysmall) .and. (g_r > verysmall)) then
11686 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
11687 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
11688 ! Additional terms in 2D and 3D
11689 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
11690 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
11691 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
11692 end if
11693 end if
11694 end do
11695 end if
11696
11697 ! Hyperelastic stress contribution: strain energy added to total energy
11698 if (hyperelasticity) then
11699
11700# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11701#if defined(MFC_OpenACC)
11702# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11703!$acc loop seq
11704# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11705#elif defined(MFC_OpenMP)
11706# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11707
11708# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11709#endif
11710 do i = 1, num_dims
11711 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
11712 xi_field_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%beg - 1 + i)
11713 end do
11714 g_l = 0._wp
11715 g_r = 0._wp
11716
11717# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11718#if defined(MFC_OpenACC)
11719# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11720!$acc loop seq
11721# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11722#elif defined(MFC_OpenMP)
11723# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11724
11725# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11726#endif
11727 do i = 1, num_fluids
11728 ! Mixture left and right shear modulus
11729 g_l = g_l + alpha_l(i)*gs_rs(i)
11730 g_r = g_r + alpha_r(i)*gs_rs(i)
11731 end do
11732 ! Elastic contribution to energy if G large enough
11733 if (g_l > verysmall .and. g_r > verysmall) then
11734 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
11735 e_r = e_r + g_r*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%xi%end + 1)
11736 end if
11737
11738# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11739#if defined(MFC_OpenACC)
11740# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11741!$acc loop seq
11742# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11743#elif defined(MFC_OpenMP)
11744# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11745
11746# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11747#endif
11748 do i = 1, b_size - 1
11749 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
11750 tau_e_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%stress%beg - 1 + i)
11751 end do
11752 end if
11753
11754 h_l = (e_l + pres_l)/rho_l
11755 h_r = (e_r + pres_r)/rho_r
11756
11757 if (avg_state == 1) then
11758# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11759 rho_avg = sqrt(rho_l*rho_r)
11760# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11761
11762# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11763 vel_avg_rms = 0._wp
11764# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11765
11766# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11767
11768# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11769#if defined(MFC_OpenACC)
11770# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11771!$acc loop seq
11772# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11773#elif defined(MFC_OpenMP)
11774# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11775
11776# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11777#endif
11778# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11779 do i = 1, num_vels
11780# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11781 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
11782# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11783 end do
11784# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11785
11786# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11787 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
11788# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11789
11790# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11791 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
11792# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11793
11794# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11795 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
11796# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11797
11798# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11799 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
11800# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11801
11802# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11803 if (chemistry) then
11804# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11805 eps = 0.001_wp
11806# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11807 call get_species_enthalpies_rt(t_l, h_il)
11808# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11809 call get_species_enthalpies_rt(t_r, h_ir)
11810# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11811 h_il = h_il*gas_constant/molecular_weights*t_l
11812# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11813 h_ir = h_ir*gas_constant/molecular_weights*t_r
11814# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11815 call get_species_specific_heats_r(t_l, cp_il)
11816# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11817 call get_species_specific_heats_r(t_r, cp_ir)
11818# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11819
11820# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11821 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
11822# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11823 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
11824# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11825 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
11826# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11827 if (abs(t_l - t_r) < eps) then
11828# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11829 ! Case when T_L and T_R are very close
11830# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11831 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
11832# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11833 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
11834# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11835 & - gas_constant/molecular_weights(:)))
11836# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11837 else
11838# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11839 ! Normal calculation when T_L and T_R are sufficiently different
11840# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11841 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
11842# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11843 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
11844# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11845 end if
11846# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11847 gamma_avg = cp_avg/cv_avg
11848# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11849
11850# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11851 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
11852# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11853 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
11854# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11855 end if
11856# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11857 end if
11858# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11859
11860# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11861 if (avg_state == 2) then
11862# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11863 rho_avg = 5.e-1_wp*(rho_l + rho_r)
11864# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11865 vel_avg_rms = 0._wp
11866# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11867
11868# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11869#if defined(MFC_OpenACC)
11870# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11871!$acc loop seq
11872# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11873#elif defined(MFC_OpenMP)
11874# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11875
11876# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11877#endif
11878# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11879 do i = 1, num_vels
11880# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11881 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
11882# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11883 end do
11884# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11885
11886# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11887 h_avg = 5.e-1_wp*(h_l + h_r)
11888# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11889 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
11890# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11891 qv_avg = 5.e-1_wp*(qv_l + qv_r)
11892# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11893 end if
11894
11895 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
11896 & c_l, qv_l)
11897
11898 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
11899 & c_r, qv_r)
11900
11901 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
11902 ! variables are placeholders to call the subroutine.
11903 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
11904 & c_sum_yi_phi, c_avg, qv_avg)
11905
11906 if (viscous) then
11907 if (chemistry) then
11908 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
11909 end if
11910
11911# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11912#if defined(MFC_OpenACC)
11913# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11914!$acc loop seq
11915# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11916#elif defined(MFC_OpenMP)
11917# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11918
11919# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11920#endif
11921 do i = 1, 2
11922 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
11923 end do
11924 end if
11925
11926 ! Low Mach correction
11927 if (low_mach == 2) then
11928 if (riemann_solver == 1 .or. riemann_solver == 5) then
11929# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11930 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11931# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11932 pcorr = 0._wp
11933# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11934
11935# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11936 if (low_mach == 1) then
11937# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11938 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
11939# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11940 end if
11941# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11942 else if (riemann_solver == 2) then
11943# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11944 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
11945# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11946 pcorr = 0._wp
11947# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11948
11949# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11950 if (low_mach == 1) then
11951# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11952 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))) &
11953# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11954 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
11955# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11956 else if (low_mach == 2) then
11957# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11958 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))))
11959# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11960 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))))
11961# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11962 vel_l(dir_idx(1)) = vel_l_tmp
11963# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11964 vel_r(dir_idx(1)) = vel_r_tmp
11965# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11966 end if
11967# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11968 end if
11969 end if
11970
11971 if (wave_speeds == 1) then
11972 if (elasticity) then
11973 ! Elastic wave speed, Rodriguez et al. JCP (2019)
11974 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) &
11975 & ))/rho_l), &
11976 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
11977 & + tau_e_r(dir_idx_tau(1)))/rho_r))
11978 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) &
11979 & ))/rho_r), &
11980 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
11981 & + tau_e_l(dir_idx_tau(1)))/rho_l))
11982 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
11983 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
11984 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
11985 & - vel_r(dir_idx(1))))
11986 else
11987 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
11988 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
11989 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
11990 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
11991 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
11992 end if
11993 else if (wave_speeds == 2) then
11994 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
11995
11996 pres_sr = pres_sl
11997
11998 ! Low Mach correction: Thornber et al. JCP (2008)
11999 ms_l = max(1._wp, &
12000 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
12001 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
12002 ms_r = max(1._wp, &
12003 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
12004 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
12005
12006 s_l = vel_l(dir_idx(1)) - c_l*ms_l
12007 s_r = vel_r(dir_idx(1)) + c_r*ms_r
12008
12009 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
12010 end if
12011
12012 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
12013 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
12014
12015 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
12016 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
12017 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
12018 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
12019 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
12020 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
12021
12022 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
12023 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
12024 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
12025
12026 ! Low Mach correction
12027 if (low_mach == 1) then
12028 if (riemann_solver == 1 .or. riemann_solver == 5) then
12029# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12030 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12031# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12032 pcorr = 0._wp
12033# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12034
12035# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12036 if (low_mach == 1) then
12037# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12038 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12039# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12040 end if
12041# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12042 else if (riemann_solver == 2) then
12043# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12044 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12045# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12046 pcorr = 0._wp
12047# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12048
12049# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12050 if (low_mach == 1) then
12051# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12052 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))) &
12053# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12054 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
12055# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12056 else if (low_mach == 2) then
12057# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12058 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))))
12059# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12060 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))))
12061# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12062 vel_l(dir_idx(1)) = vel_l_tmp
12063# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12064 vel_r(dir_idx(1)) = vel_r_tmp
12065# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12066 end if
12067# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12068 end if
12069 else
12070 pcorr = 0._wp
12071 end if
12072
12073 ! COMPUTING THE HLLC FLUXES MASS FLUX.
12074
12075# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12076#if defined(MFC_OpenACC)
12077# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12078!$acc loop seq
12079# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12080#elif defined(MFC_OpenMP)
12081# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12082
12083# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12084#endif
12085 do i = 1, eqn_idx%cont%end
12086 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
12087 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
12088 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
12089 end do
12090
12091 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
12092 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
12093
12094# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12095#if defined(MFC_OpenACC)
12096# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12097!$acc loop seq
12098# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12099#elif defined(MFC_OpenMP)
12100# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12101
12102# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12103#endif
12104 do i = 1, num_dims
12105 flux_rsx_vf(j, k, l, &
12106 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
12107 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
12108 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
12109 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
12110 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
12111 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
12112 end do
12113
12114 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
12115 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
12116 flux_rsx_vf(j, k, l, &
12117 & 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 &
12118 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
12119 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
12120 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
12121 & *(s_p/s_r)*pcorr*s_s
12122
12123 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
12124 if (elasticity) then
12125 flux_ene_e = 0._wp
12126
12127# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12128#if defined(MFC_OpenACC)
12129# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12130!$acc loop seq
12131# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12132#elif defined(MFC_OpenMP)
12133# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12134
12135# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12136#endif
12137 do i = 1, num_dims
12138 ! MOMENTUM ELASTIC FLUX.
12139 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
12140 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
12141 & - xi_p*tau_e_r(dir_idx_tau(i))
12142 ! ENERGY ELASTIC FLUX.
12143 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
12144 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
12145 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
12146 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
12147 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
12148 end do
12149 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
12150 end if
12151
12152 ! HYPOELASTIC STRESS EVOLUTION FLUX.
12153 if (hypoelasticity) then
12154
12155# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12156#if defined(MFC_OpenACC)
12157# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12158!$acc loop seq
12159# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12160#elif defined(MFC_OpenMP)
12161# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12162
12163# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12164#endif
12165 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
12166 flux_rsx_vf(j, k, l, &
12167 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
12168 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
12169 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
12170 end do
12171 end if
12172
12173 ! VOLUME FRACTION FLUX.
12174
12175# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12176#if defined(MFC_OpenACC)
12177# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12178!$acc loop seq
12179# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12180#elif defined(MFC_OpenMP)
12181# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12182
12183# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12184#endif
12185 do i = eqn_idx%adv%beg, eqn_idx%adv%end
12186 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
12187 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k + 1, l, &
12188 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
12189 end do
12190
12191 ! VOLUME FRACTION SOURCE FLUX.
12192
12193# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12194#if defined(MFC_OpenACC)
12195# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12196!$acc loop seq
12197# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12198#elif defined(MFC_OpenMP)
12199# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12200
12201# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12202#endif
12203 do i = 1, num_dims
12204 vel_src_rsx_vf(j, k, l, &
12205 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
12206 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
12207 end do
12208
12209 ! COLOR FUNCTION FLUX
12210 if (surface_tension) then
12211 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
12212 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
12213 & + xi_p*qr_prim_rsx_vf(j, k + 1, l, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
12214 end if
12215
12216 ! Hyperelastic reference map flux for material deformation tracking
12217 if (hyperelasticity) then
12218
12219# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12220#if defined(MFC_OpenACC)
12221# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12222!$acc loop seq
12223# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12224#elif defined(MFC_OpenMP)
12225# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12226
12227# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12228#endif
12229 do i = 1, num_dims
12230 flux_rsx_vf(j, k, l, &
12231 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
12232 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
12233 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
12234 end do
12235 end if
12236
12237 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
12238
12239 if (chemistry) then
12240
12241# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12242#if defined(MFC_OpenACC)
12243# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12244!$acc loop seq
12245# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12246#elif defined(MFC_OpenMP)
12247# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12248
12249# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12250#endif
12251 do i = eqn_idx%species%beg, eqn_idx%species%end
12252 y_l = ql_prim_rsx_vf(j, k, l, i)
12253 y_r = qr_prim_rsx_vf(j, k + 1, l, i)
12254
12255 flux_rsx_vf(j, k, l, &
12256 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
12257 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
12258 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
12259 end do
12260 end if
12261
12262 ! Geometrical source flux for cylindrical coordinates
12263# 3243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12264 if (cyl_coord) then
12265 ! Substituting the advective flux into the inviscid geometrical source flux
12266
12267# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12268#if defined(MFC_OpenACC)
12269# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12270!$acc loop seq
12271# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12272#elif defined(MFC_OpenMP)
12273# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12274
12275# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12276#endif
12277 do i = 1, eqn_idx%E
12278 flux_gsrc_rsx_vf(j, k, l, i) = flux_rsx_vf(j, k, l, i)
12279 end do
12280 ! Recalculating the radial momentum geometric source flux
12281 flux_gsrc_rsx_vf(j, k, l, &
12282 & eqn_idx%cont%end + dir_idx(1)) = xi_m*(rho_l*(vel_l(dir_idx(1)) &
12283 & *vel_l(dir_idx(1)) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp &
12284 & - dir_flg(dir_idx(1)))*vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
12285 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
12286 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
12287 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
12288 ! Geometrical source of the void fraction(s) is zero
12289
12290# 3258 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12291#if defined(MFC_OpenACC)
12292# 3258 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12293!$acc loop seq
12294# 3258 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12295#elif defined(MFC_OpenMP)
12296# 3258 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12297
12298# 3258 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12299#endif
12300 do i = eqn_idx%adv%beg, eqn_idx%adv%end
12301 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
12302 end do
12303 end if
12304# 3264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12305# 3281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12306 end do
12307 end do
12308 end do
12309
12310# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12311#if defined(MFC_OpenACC)
12312# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12313!$acc end parallel loop
12314# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12315#elif defined(MFC_OpenMP)
12316# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12317
12318# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12319!$omp end target teams loop
12320# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12321#endif
12322 end if
12323 end if
12324# 1790 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12325# 1791 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12326# 1792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12327 if (norm_dir == 3) then
12328 ! 6-EQUATION MODEL WITH HLLC HLLC star-state flux with contact wave speed s_S
12329 if (model_eqns == 3) then
12330 ! 6-equation model (model_eqns=3): separate phasic internal energies
12331
12332# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12333
12334# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12335#if defined(MFC_OpenACC)
12336# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12337!$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)
12338# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12339#elif defined(MFC_OpenMP)
12340# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12341
12342# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12343
12344# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12345
12346# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12347!$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)
12348# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12349#endif
12350# 1806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12351 do l = is1%beg, is1%end
12352 do k = is2%beg, is2%end
12353 do j = is3%beg, is3%end
12354 vel_l_rms = 0._wp; vel_r_rms = 0._wp
12355 rho_l = 0._wp; rho_r = 0._wp
12356 gamma_l = 0._wp; gamma_r = 0._wp
12357 pi_inf_l = 0._wp; pi_inf_r = 0._wp
12358 qv_l = 0._wp; qv_r = 0._wp
12359 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
12360
12361
12362# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12363#if defined(MFC_OpenACC)
12364# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12365!$acc loop seq
12366# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12367#elif defined(MFC_OpenMP)
12368# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12369
12370# 1816 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12371#endif
12372 do i = 1, num_dims
12373 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
12374 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
12375 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
12376 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
12377 end do
12378
12379 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
12380 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
12381
12382 rho_l = 0._wp
12383 gamma_l = 0._wp
12384 pi_inf_l = 0._wp
12385 qv_l = 0._wp
12386
12387 rho_r = 0._wp
12388 gamma_r = 0._wp
12389 pi_inf_r = 0._wp
12390 qv_r = 0._wp
12391
12392 alpha_l_sum = 0._wp
12393 alpha_r_sum = 0._wp
12394
12395 if (mpp_lim) then
12396
12397# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12398#if defined(MFC_OpenACC)
12399# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12400!$acc loop seq
12401# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12402#elif defined(MFC_OpenMP)
12403# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12404
12405# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12406#endif
12407 do i = 1, num_fluids
12408 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
12409 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
12410 & eqn_idx%E + i)), 1._wp)
12411 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
12412 end do
12413
12414
12415# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12416#if defined(MFC_OpenACC)
12417# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12418!$acc loop seq
12419# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12420#elif defined(MFC_OpenMP)
12421# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12422
12423# 1849 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12424#endif
12425 do i = 1, num_fluids
12426 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
12427 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
12428 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
12429 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
12430 end do
12431
12432
12433# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12434#if defined(MFC_OpenACC)
12435# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12436!$acc loop seq
12437# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12438#elif defined(MFC_OpenMP)
12439# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12440
12441# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12442#endif
12443 do i = 1, num_fluids
12444 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
12445 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
12446 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
12447 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
12448 end do
12449 end if
12450
12451
12452# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12453#if defined(MFC_OpenACC)
12454# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12455!$acc loop seq
12456# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12457#elif defined(MFC_OpenMP)
12458# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12459
12460# 1866 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12461#endif
12462 do i = 1, num_fluids
12463 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
12464 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
12465 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
12466 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
12467
12468 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
12469 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
12470 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
12471 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
12472
12473 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%adv%beg + i - 1)
12474 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%adv%beg + i - 1)
12475 end do
12476
12477 if (viscous) then
12478
12479# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12480#if defined(MFC_OpenACC)
12481# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12482!$acc loop seq
12483# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12484#elif defined(MFC_OpenMP)
12485# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12486
12487# 1883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12488#endif
12489 do i = 1, 2
12490 re_l(i) = dflt_real
12491 re_r(i) = dflt_real
12492 if (re_size(i) > 0) re_l(i) = 0._wp
12493 if (re_size(i) > 0) re_r(i) = 0._wp
12494
12495# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12496#if defined(MFC_OpenACC)
12497# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12498!$acc loop seq
12499# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12500#elif defined(MFC_OpenMP)
12501# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12502
12503# 1889 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12504#endif
12505 do q = 1, re_size(i)
12506 re_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, q))/res_gs(i, q) + re_l(i)
12507 re_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + re_idx(i, q))/res_gs(i, &
12508 & q) + re_r(i)
12509 end do
12510 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
12511 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
12512 end do
12513 end if
12514
12515 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
12516 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
12517
12518 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
12519 if (hypoelasticity) then
12520
12521# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12522#if defined(MFC_OpenACC)
12523# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12524!$acc loop seq
12525# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12526#elif defined(MFC_OpenMP)
12527# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12528
12529# 1905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12530#endif
12531 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
12532 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
12533 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
12534 end do
12535 g_l = 0._wp; g_r = 0._wp
12536
12537# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12538#if defined(MFC_OpenACC)
12539# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12540!$acc loop seq
12541# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12542#elif defined(MFC_OpenMP)
12543# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12544
12545# 1911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12546#endif
12547 do i = 1, num_fluids
12548 g_l = g_l + alpha_l(i)*gs_rs(i)
12549 g_r = g_r + alpha_r(i)*gs_rs(i)
12550 end do
12551
12552# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12553#if defined(MFC_OpenACC)
12554# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12555!$acc loop seq
12556# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12557#elif defined(MFC_OpenMP)
12558# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12559
12560# 1916 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12561#endif
12562 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
12563 ! Elastic contribution to energy if G large enough
12564 if ((g_l > verysmall) .and. (g_r > verysmall)) then
12565 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
12566 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
12567 ! Additional terms in 2D and 3D
12568 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
12569 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
12570 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
12571 end if
12572 end if
12573 end do
12574 end if
12575
12576 ! Hyperelastic stress contribution: strain energy added to total energy
12577 if (hyperelasticity) then
12578
12579# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12580#if defined(MFC_OpenACC)
12581# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12582!$acc loop seq
12583# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12584#elif defined(MFC_OpenMP)
12585# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12586
12587# 1933 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12588#endif
12589 do i = 1, num_dims
12590 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
12591 xi_field_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%beg - 1 + i)
12592 end do
12593 g_l = 0._wp; g_r = 0._wp
12594
12595# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12596#if defined(MFC_OpenACC)
12597# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12598!$acc loop seq
12599# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12600#elif defined(MFC_OpenMP)
12601# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12602
12603# 1939 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12604#endif
12605 do i = 1, num_fluids
12606 ! Mixture left and right shear modulus
12607 g_l = g_l + alpha_l(i)*gs_rs(i)
12608 g_r = g_r + alpha_r(i)*gs_rs(i)
12609 end do
12610 ! Elastic contribution to energy if G large enough
12611 if (g_l > verysmall .and. g_r > verysmall) then
12612 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
12613 e_r = e_r + g_r*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%end + 1)
12614 end if
12615
12616# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12617#if defined(MFC_OpenACC)
12618# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12619!$acc loop seq
12620# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12621#elif defined(MFC_OpenMP)
12622# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12623
12624# 1950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12625#endif
12626 do i = 1, b_size - 1
12627 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
12628 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
12629 end do
12630 end if
12631
12632 h_l = (e_l + pres_l)/rho_l
12633 h_r = (e_r + pres_r)/rho_r
12634
12635 if (avg_state == 1) then
12636# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12637 rho_avg = sqrt(rho_l*rho_r)
12638# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12639
12640# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12641 vel_avg_rms = 0._wp
12642# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12643
12644# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12645
12646# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12647#if defined(MFC_OpenACC)
12648# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12649!$acc loop seq
12650# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12651#elif defined(MFC_OpenMP)
12652# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12653
12654# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12655#endif
12656# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12657 do i = 1, num_vels
12658# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12659 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
12660# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12661 end do
12662# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12663
12664# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12665 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
12666# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12667
12668# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12669 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
12670# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12671
12672# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12673 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
12674# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12675
12676# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12677 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
12678# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12679
12680# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12681 if (chemistry) then
12682# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12683 eps = 0.001_wp
12684# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12685 call get_species_enthalpies_rt(t_l, h_il)
12686# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12687 call get_species_enthalpies_rt(t_r, h_ir)
12688# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12689 h_il = h_il*gas_constant/molecular_weights*t_l
12690# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12691 h_ir = h_ir*gas_constant/molecular_weights*t_r
12692# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12693 call get_species_specific_heats_r(t_l, cp_il)
12694# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12695 call get_species_specific_heats_r(t_r, cp_ir)
12696# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12697
12698# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12699 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
12700# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12701 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
12702# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12703 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
12704# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12705 if (abs(t_l - t_r) < eps) then
12706# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12707 ! Case when T_L and T_R are very close
12708# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12709 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
12710# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12711 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
12712# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12713 & - gas_constant/molecular_weights(:)))
12714# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12715 else
12716# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12717 ! Normal calculation when T_L and T_R are sufficiently different
12718# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12719 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
12720# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12721 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
12722# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12723 end if
12724# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12725 gamma_avg = cp_avg/cv_avg
12726# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12727
12728# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12729 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
12730# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12731 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
12732# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12733 end if
12734# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12735 end if
12736# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12737
12738# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12739 if (avg_state == 2) then
12740# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12741 rho_avg = 5.e-1_wp*(rho_l + rho_r)
12742# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12743 vel_avg_rms = 0._wp
12744# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12745
12746# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12747#if defined(MFC_OpenACC)
12748# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12749!$acc loop seq
12750# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12751#elif defined(MFC_OpenMP)
12752# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12753
12754# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12755#endif
12756# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12757 do i = 1, num_vels
12758# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12759 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
12760# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12761 end do
12762# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12763
12764# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12765 h_avg = 5.e-1_wp*(h_l + h_r)
12766# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12767 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
12768# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12769 qv_avg = 5.e-1_wp*(qv_l + qv_r)
12770# 1960 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12771 end if
12772
12773 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
12774 & c_l, qv_l)
12775
12776 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
12777 & c_r, qv_r)
12778
12779 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
12780 ! variables are placeholders to call the subroutine.
12781 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
12782 & 0._wp, c_avg, qv_avg)
12783
12784 if (viscous) then
12785
12786# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12787#if defined(MFC_OpenACC)
12788# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12789!$acc loop seq
12790# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12791#elif defined(MFC_OpenMP)
12792# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12793
12794# 1974 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12795#endif
12796 do i = 1, 2
12797 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
12798 end do
12799 end if
12800
12801 ! Low Mach correction
12802 if (low_mach == 2) then
12803 if (riemann_solver == 1 .or. riemann_solver == 5) then
12804# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12805 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12806# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12807 pcorr = 0._wp
12808# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12809
12810# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12811 if (low_mach == 1) then
12812# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12813 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12814# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12815 end if
12816# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12817 else if (riemann_solver == 2) then
12818# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12819 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12820# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12821 pcorr = 0._wp
12822# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12823
12824# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12825 if (low_mach == 1) then
12826# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12827 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))) &
12828# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12829 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
12830# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12831 else if (low_mach == 2) then
12832# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12833 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))))
12834# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12835 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))))
12836# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12837 vel_l(dir_idx(1)) = vel_l_tmp
12838# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12839 vel_r(dir_idx(1)) = vel_r_tmp
12840# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12841 end if
12842# 1982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12843 end if
12844 end if
12845
12846 ! COMPUTING THE DIRECT WAVE SPEEDS
12847 if (wave_speeds == 1) then
12848 if (elasticity) then
12849 ! Elastic wave speed, Rodriguez et al. JCP (2019)
12850 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) &
12851 & ))/rho_l), &
12852 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
12853 & + tau_e_r(dir_idx_tau(1)))/rho_r))
12854 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) &
12855 & ))/rho_r), &
12856 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
12857 & + tau_e_l(dir_idx_tau(1)))/rho_l))
12858 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
12859 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
12860 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
12861 & - vel_r(dir_idx(1))))
12862 else
12863 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
12864 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
12865 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
12866 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
12867 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
12868 end if
12869 else if (wave_speeds == 2) then
12870 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
12871
12872 pres_sr = pres_sl
12873
12874 ! Low Mach correction: Thornber et al. JCP (2008)
12875 ms_l = max(1._wp, &
12876 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
12877 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
12878 ms_r = max(1._wp, &
12879 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
12880 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
12881
12882 s_l = vel_l(dir_idx(1)) - c_l*ms_l
12883 s_r = vel_r(dir_idx(1)) + c_r*ms_r
12884
12885 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
12886 end if
12887
12888 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
12889 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
12890
12891 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
12892 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
12893 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
12894 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
12895 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
12896
12897 ! goes with numerical star velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
12898 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
12899 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
12900
12901 ! goes with the numerical velocity in x/y/z directions xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
12902 xi_mp = -min(0._wp, sign(1._wp, s_l))
12903 xi_pp = max(0._wp, sign(1._wp, s_r))
12904
12905 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 &
12906 & - vel_l(dir_idx(1))))) - e_l)) + xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s &
12907 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
12908 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) &
12909 & + xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
12910
12911 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))
12912
12913 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 &
12914 & - vel_r(dir_idx(1)))
12915
12916 ! Low Mach correction
12917 if (low_mach == 1) then
12918 if (riemann_solver == 1 .or. riemann_solver == 5) then
12919# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12920 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12921# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12922 pcorr = 0._wp
12923# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12924
12925# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12926 if (low_mach == 1) then
12927# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12928 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12929# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12930 end if
12931# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12932 else if (riemann_solver == 2) then
12933# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12934 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12935# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12936 pcorr = 0._wp
12937# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12938
12939# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12940 if (low_mach == 1) then
12941# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12942 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))) &
12943# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12944 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
12945# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12946 else if (low_mach == 2) then
12947# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12948 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))))
12949# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12950 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))))
12951# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12952 vel_l(dir_idx(1)) = vel_l_tmp
12953# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12954 vel_r(dir_idx(1)) = vel_r_tmp
12955# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12956 end if
12957# 2057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12958 end if
12959 else
12960 pcorr = 0._wp
12961 end if
12962
12963 ! COMPUTING FLUXES MASS FLUX.
12964
12965# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12966#if defined(MFC_OpenACC)
12967# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12968!$acc loop seq
12969# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12970#elif defined(MFC_OpenMP)
12971# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12972
12973# 2063 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12974#endif
12975 do i = 1, eqn_idx%cont%end
12976 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
12977 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
12978 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
12979 end do
12980
12981 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
12982
12983# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12984#if defined(MFC_OpenACC)
12985# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12986!$acc loop seq
12987# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12988#elif defined(MFC_OpenMP)
12989# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12990
12991# 2071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12992#endif
12993 do i = 1, num_dims
12994 flux_rsx_vf(j, k, l, &
12995 & eqn_idx%cont%end + dir_idx(i)) = rho_star*vel_k_star*(dir_flg(dir_idx(i)) &
12996 & *vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) &
12997 & + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star + (s_m/s_l)*(s_p/s_r) &
12998 & *dir_flg(dir_idx(i))*pcorr
12999 end do
13000
13001 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
13002 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
13003
13004 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
13005 if (elasticity) then
13006 flux_ene_e = 0._wp
13007
13008# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13009#if defined(MFC_OpenACC)
13010# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13011!$acc loop seq
13012# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13013#elif defined(MFC_OpenMP)
13014# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13015
13016# 2086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13017#endif
13018 do i = 1, num_dims
13019 ! MOMENTUM ELASTIC FLUX.
13020 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
13021 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
13022 & - xi_p*tau_e_r(dir_idx_tau(i))
13023 ! ENERGY ELASTIC FLUX.
13024 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
13025 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
13026 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
13027 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
13028 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
13029 end do
13030 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
13031 end if
13032
13033 ! VOLUME FRACTION FLUX.
13034
13035# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13036#if defined(MFC_OpenACC)
13037# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13038!$acc loop seq
13039# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13040#elif defined(MFC_OpenMP)
13041# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13042
13043# 2103 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13044#endif
13045 do i = eqn_idx%adv%beg, eqn_idx%adv%end
13046 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
13047 & i)*s_s + xi_p*qr_prim_rsx_vf(j, k, l + 1, i)*s_s
13048 end do
13049
13050 ! Advection velocity source: interface velocity for volume fraction transport
13051
13052# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13053#if defined(MFC_OpenACC)
13054# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13055!$acc loop seq
13056# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13057#elif defined(MFC_OpenMP)
13058# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13059
13060# 2110 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13061#endif
13062 do i = 1, num_dims
13063 vel_src_rsx_vf(j, k, l, &
13064 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i)) &
13065 & *(s_s*(xi_mp*xi_l_m1 + 1) - vel_l(dir_idx(i)))) + xi_p*(vel_r(dir_idx(i)) &
13066 & + dir_flg(dir_idx(i))*(s_s*(xi_pp*xi_r_m1 + 1) - vel_r(dir_idx(i))))
13067 end do
13068
13069 ! INTERNAL ENERGIES ADVECTION FLUX. K-th pressure and velocity in preparation for the internal
13070 ! energy flux
13071
13072# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13073#if defined(MFC_OpenACC)
13074# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13075!$acc loop seq
13076# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13077#elif defined(MFC_OpenMP)
13078# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13079
13080# 2120 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13081#endif
13082 do i = 1, num_fluids
13083 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))*xi_l**(1._wp/gammas(i) &
13084 & + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) &
13085 & + xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i))) &
13086 & *xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) &
13087 & + pres_r)
13088
13089 flux_rsx_vf(j, k, l, i + eqn_idx%int_en%beg - 1) = ((xi_m*ql_prim_rsx_vf(j, k, l, &
13090 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
13091 & i + eqn_idx%adv%beg - 1))*(gammas(i)*p_k_star + pi_infs(i)) &
13092 & + (xi_m*ql_prim_rsx_vf(j, k, l, &
13093 & i + eqn_idx%cont%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
13094 & i + eqn_idx%cont%beg - 1))*qvs(i))*vel_k_star + (s_m/s_l)*(s_p/s_r) &
13095 & *pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, &
13096 & i + eqn_idx%adv%beg - 1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
13097 & i + eqn_idx%adv%beg - 1))
13098 end do
13099
13100 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
13101
13102 ! HYPOELASTIC STRESS EVOLUTION FLUX.
13103 if (hypoelasticity) then
13104
13105# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13106#if defined(MFC_OpenACC)
13107# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13108!$acc loop seq
13109# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13110#elif defined(MFC_OpenMP)
13111# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13112
13113# 2143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13114#endif
13115 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
13116 flux_rsx_vf(j, k, l, &
13117 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
13118 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
13119 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
13120 end do
13121 end if
13122
13123 ! Hyperelastic reference map flux for material deformation tracking
13124 if (hyperelasticity) then
13125
13126# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13127#if defined(MFC_OpenACC)
13128# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13129!$acc loop seq
13130# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13131#elif defined(MFC_OpenMP)
13132# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13133
13134# 2154 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13135#endif
13136 do i = 1, num_dims
13137 flux_rsx_vf(j, k, l, &
13138 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
13139 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
13140 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
13141 end do
13142 end if
13143
13144 ! COLOR FUNCTION FLUX
13145 if (surface_tension) then
13146 flux_rsx_vf(j, k, l, eqn_idx%c) = (xi_m*ql_prim_rsx_vf(j, k, l, &
13147 & eqn_idx%c) + xi_p*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%c))*s_s
13148 end if
13149
13150 ! Geometrical source flux for cylindrical coordinates
13151# 2192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13152# 2193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13153 if (grid_geometry == 3) then
13154
13155# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13156#if defined(MFC_OpenACC)
13157# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13158!$acc loop seq
13159# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13160#elif defined(MFC_OpenMP)
13161# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13162
13163# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13164#endif
13165 do i = 1, sys_size
13166 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
13167 end do
13168 flux_gsrc_rsx_vf(j, k, l, &
13169 & eqn_idx%mom%beg - 1 + dir_idx(1)) = flux_gsrc_rsx_vf(j, k, l, &
13170 & eqn_idx%mom%beg - 1 + dir_idx(1)) - p_star
13171
13172 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
13173 end if
13174# 2205 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13175 end do
13176 end do
13177 end do
13178
13179# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13180#if defined(MFC_OpenACC)
13181# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13182!$acc end parallel loop
13183# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13184#elif defined(MFC_OpenMP)
13185# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13186
13187# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13188!$omp end target teams loop
13189# 2208 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13190#endif
13191 else if (model_eqns == 4) then
13192 ! 4-equation model (model_eqns=4): single pressure, velocity equilibrium
13193
13194# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13195
13196# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13197#if defined(MFC_OpenACC)
13198# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13199!$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)
13200# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13201#elif defined(MFC_OpenMP)
13202# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13203
13204# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13205
13206# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13207
13208# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13209!$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)
13210# 2211 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13211#endif
13212# 2220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13213 do l = is1%beg, is1%end
13214 do k = is2%beg, is2%end
13215 do j = is3%beg, is3%end
13216 vel_l_rms = 0._wp; vel_r_rms = 0._wp
13217 rho_l = 0._wp; rho_r = 0._wp
13218 gamma_l = 0._wp; gamma_r = 0._wp
13219 pi_inf_l = 0._wp; pi_inf_r = 0._wp
13220 qv_l = 0._wp; qv_r = 0._wp
13221
13222
13223# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13224#if defined(MFC_OpenACC)
13225# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13226!$acc loop seq
13227# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13228#elif defined(MFC_OpenMP)
13229# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13230
13231# 2229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13232#endif
13233 do i = 1, eqn_idx%cont%end
13234 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
13235 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
13236 end do
13237
13238
13239# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13240#if defined(MFC_OpenACC)
13241# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13242!$acc loop seq
13243# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13244#elif defined(MFC_OpenMP)
13245# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13246
13247# 2235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13248#endif
13249 do i = 1, num_dims
13250 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
13251 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
13252 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
13253 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
13254 end do
13255
13256
13257# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13258#if defined(MFC_OpenACC)
13259# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13260!$acc loop seq
13261# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13262#elif defined(MFC_OpenMP)
13263# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13264
13265# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13266#endif
13267 do i = 1, num_fluids
13268 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
13269 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
13270 end do
13271
13272# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13273#if defined(MFC_OpenACC)
13274# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13275!$acc loop seq
13276# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13277#elif defined(MFC_OpenMP)
13278# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13279
13280# 2248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13281#endif
13282 do i = 1, num_fluids
13283 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
13284 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
13285 end do
13286
13287
13288# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13289#if defined(MFC_OpenACC)
13290# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13291!$acc loop seq
13292# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13293#elif defined(MFC_OpenMP)
13294# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13295
13296# 2254 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13297#endif
13298 do i = 1, num_fluids
13299 rho_l = rho_l + alpha_rho_l(i)
13300 gamma_l = gamma_l + alpha_l(i)*gammas(i)
13301 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
13302 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
13303
13304 rho_r = rho_r + alpha_rho_r(i)
13305 gamma_r = gamma_r + alpha_r(i)*gammas(i)
13306 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
13307 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
13308 end do
13309
13310 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
13311 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
13312
13313 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
13314 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
13315
13316 h_l = (e_l + pres_l)/rho_l
13317 h_r = (e_r + pres_r)/rho_r
13318
13319 if (avg_state == 1) then
13320# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13321 rho_avg = sqrt(rho_l*rho_r)
13322# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13323
13324# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13325 vel_avg_rms = 0._wp
13326# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13327
13328# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13329
13330# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13331#if defined(MFC_OpenACC)
13332# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13333!$acc loop seq
13334# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13335#elif defined(MFC_OpenMP)
13336# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13337
13338# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13339#endif
13340# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13341 do i = 1, num_vels
13342# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13343 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
13344# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13345 end do
13346# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13347
13348# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13349 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
13350# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13351
13352# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13353 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
13354# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13355
13356# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13357 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
13358# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13359
13360# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13361 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
13362# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13363
13364# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13365 if (chemistry) then
13366# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13367 eps = 0.001_wp
13368# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13369 call get_species_enthalpies_rt(t_l, h_il)
13370# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13371 call get_species_enthalpies_rt(t_r, h_ir)
13372# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13373 h_il = h_il*gas_constant/molecular_weights*t_l
13374# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13375 h_ir = h_ir*gas_constant/molecular_weights*t_r
13376# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13377 call get_species_specific_heats_r(t_l, cp_il)
13378# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13379 call get_species_specific_heats_r(t_r, cp_ir)
13380# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13381
13382# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13383 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
13384# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13385 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
13386# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13387 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
13388# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13389 if (abs(t_l - t_r) < eps) then
13390# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13391 ! Case when T_L and T_R are very close
13392# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13393 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
13394# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13395 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
13396# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13397 & - gas_constant/molecular_weights(:)))
13398# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13399 else
13400# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13401 ! Normal calculation when T_L and T_R are sufficiently different
13402# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13403 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
13404# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13405 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
13406# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13407 end if
13408# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13409 gamma_avg = cp_avg/cv_avg
13410# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13411
13412# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13413 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
13414# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13415 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
13416# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13417 end if
13418# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13419 end if
13420# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13421
13422# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13423 if (avg_state == 2) then
13424# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13425 rho_avg = 5.e-1_wp*(rho_l + rho_r)
13426# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13427 vel_avg_rms = 0._wp
13428# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13429
13430# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13431#if defined(MFC_OpenACC)
13432# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13433!$acc loop seq
13434# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13435#elif defined(MFC_OpenMP)
13436# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13437
13438# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13439#endif
13440# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13441 do i = 1, num_vels
13442# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13443 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
13444# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13445 end do
13446# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13447
13448# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13449 h_avg = 5.e-1_wp*(h_l + h_r)
13450# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13451 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
13452# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13453 qv_avg = 5.e-1_wp*(qv_l + qv_r)
13454# 2276 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13455 end if
13456
13457 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
13458 & c_l, qv_l)
13459
13460 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
13461 & c_r, qv_r)
13462
13463 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
13464 ! variables are placeholders to call the subroutine.
13465
13466 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
13467 & 0._wp, c_avg, qv_avg)
13468
13469 if (wave_speeds == 1) then
13470 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
13471 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
13472
13473 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
13474 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
13475 & - rho_r*(s_r - vel_r(dir_idx(1))))
13476 else if (wave_speeds == 2) then
13477 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
13478
13479 pres_sr = pres_sl
13480
13481 ! Low Mach correction: Thornber et al. JCP (2008)
13482 ms_l = max(1._wp, &
13483 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
13484 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
13485 ms_r = max(1._wp, &
13486 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
13487 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
13488
13489 s_l = vel_l(dir_idx(1)) - c_l*ms_l
13490 s_r = vel_r(dir_idx(1)) + c_r*ms_r
13491
13492 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
13493 end if
13494
13495 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
13496 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
13497
13498 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
13499 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
13500 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
13501 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
13502 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
13503
13504 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
13505 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
13506 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
13507
13508
13509# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13510#if defined(MFC_OpenACC)
13511# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13512!$acc loop seq
13513# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13514#elif defined(MFC_OpenMP)
13515# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13516
13517# 2329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13518#endif
13519 do i = 1, eqn_idx%cont%end
13520 flux_rsx_vf(j, k, l, &
13521 & i) = xi_m*alpha_rho_l(i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*alpha_rho_r(i) &
13522 & *(vel_r(dir_idx(1)) + s_p*xi_r_m1)
13523 end do
13524
13525 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
13526
13527# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13528#if defined(MFC_OpenACC)
13529# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13530!$acc loop seq
13531# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13532#elif defined(MFC_OpenMP)
13533# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13534
13535# 2337 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13536#endif
13537 do i = 1, num_dims
13538 flux_rsx_vf(j, k, l, &
13539 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
13540 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
13541 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_l) &
13542 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
13543 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
13544 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*pres_r)
13545 end do
13546
13547 if (bubbles_euler) then
13548 ! Put p_tilde in
13549
13550# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13551#if defined(MFC_OpenACC)
13552# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13553!$acc loop seq
13554# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13555#elif defined(MFC_OpenMP)
13556# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13557
13558# 2350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13559#endif
13560 do i = 1, num_dims
13561 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
13562 & eqn_idx%cont%end + dir_idx(i)) + xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l) &
13563 & ) + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
13564 end do
13565 end if
13566
13567 flux_rsx_vf(j, k, l, eqn_idx%E) = 0._wp
13568
13569
13570# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13571#if defined(MFC_OpenACC)
13572# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13573!$acc loop seq
13574# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13575#elif defined(MFC_OpenMP)
13576# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13577
13578# 2360 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13579#endif
13580 do i = eqn_idx%alf, eqn_idx%alf ! only advect the void fraction
13581 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
13582 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
13583 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
13584 end do
13585
13586 ! Advection velocity source: interface velocity for volume fraction transport
13587
13588# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13589#if defined(MFC_OpenACC)
13590# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13591!$acc loop seq
13592# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13593#elif defined(MFC_OpenMP)
13594# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13595
13596# 2368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13597#endif
13598 do i = 1, num_dims
13599 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
13600 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
13601 end do
13602
13603 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
13604
13605 ! Add advection flux for bubble variables
13606 if (bubbles_euler) then
13607
13608# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13609#if defined(MFC_OpenACC)
13610# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13611!$acc loop seq
13612# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13613#elif defined(MFC_OpenMP)
13614# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13615
13616# 2378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13617#endif
13618 do i = eqn_idx%bub%beg, eqn_idx%bub%end
13619 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
13620 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
13621 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k, l + 1, &
13622 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
13623 end do
13624 end if
13625
13626 ! Geometrical source flux for cylindrical coordinates
13627
13628# 2411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13629# 2412 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13630 if (grid_geometry == 3) then
13631
13632# 2413 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13633#if defined(MFC_OpenACC)
13634# 2413 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13635!$acc loop seq
13636# 2413 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13637#elif defined(MFC_OpenMP)
13638# 2413 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13639
13640# 2413 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13641#endif
13642 do i = 1, sys_size
13643 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
13644 end do
13645 flux_gsrc_rsx_vf(j, k, l, &
13646 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1) &
13647 & ) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
13648 & *vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
13649 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
13650 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
13651 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
13652 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
13653 end if
13654# 2427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13655 end do
13656 end do
13657 end do
13658
13659# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13660#if defined(MFC_OpenACC)
13661# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13662!$acc end parallel loop
13663# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13664#elif defined(MFC_OpenMP)
13665# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13666
13667# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13668!$omp end target teams loop
13669# 2430 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13670#endif
13671 else if (model_eqns == 2 .and. bubbles_euler) then
13672 ! 5-equation model with Euler-Euler bubble dynamics
13673
13674# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13675
13676# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13677#if defined(MFC_OpenACC)
13678# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13679!$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)
13680# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13681#elif defined(MFC_OpenMP)
13682# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13683
13684# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13685
13686# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13687
13688# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13689!$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)
13690# 2433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13691#endif
13692# 2441 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13693 do l = is1%beg, is1%end
13694 do k = is2%beg, is2%end
13695 do j = is3%beg, is3%end
13696 vel_l_rms = 0._wp; vel_r_rms = 0._wp
13697 rho_l = 0._wp; rho_r = 0._wp
13698 gamma_l = 0._wp; gamma_r = 0._wp
13699 pi_inf_l = 0._wp; pi_inf_r = 0._wp
13700 qv_l = 0._wp; qv_r = 0._wp
13701
13702
13703# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13704#if defined(MFC_OpenACC)
13705# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13706!$acc loop seq
13707# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13708#elif defined(MFC_OpenMP)
13709# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13710
13711# 2450 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13712#endif
13713 do i = 1, num_fluids
13714 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
13715 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
13716 end do
13717
13718 vel_l_rms = 0._wp; vel_r_rms = 0._wp
13719
13720
13721# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13722#if defined(MFC_OpenACC)
13723# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13724!$acc loop seq
13725# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13726#elif defined(MFC_OpenMP)
13727# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13728
13729# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13730#endif
13731 do i = 1, num_dims
13732 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
13733 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
13734 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
13735 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
13736 end do
13737
13738 ! Retain this in the refactor
13739 if (mpp_lim .and. (num_fluids > 2)) then
13740
13741# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13742#if defined(MFC_OpenACC)
13743# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13744!$acc loop seq
13745# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13746#elif defined(MFC_OpenMP)
13747# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13748
13749# 2468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13750#endif
13751 do i = 1, num_fluids
13752 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
13753 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
13754 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
13755 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
13756 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
13757 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
13758 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
13759 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
13760 end do
13761 else if (num_fluids > 2) then
13762
13763# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13764#if defined(MFC_OpenACC)
13765# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13766!$acc loop seq
13767# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13768#elif defined(MFC_OpenMP)
13769# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13770
13771# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13772#endif
13773 do i = 1, num_fluids - 1
13774 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
13775 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
13776 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
13777 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
13778 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
13779 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
13780 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
13781 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
13782 end do
13783 else
13784 rho_l = ql_prim_rsx_vf(j, k, l, 1)
13785 gamma_l = gammas(1)
13786 pi_inf_l = pi_infs(1)
13787 qv_l = qvs(1)
13788 rho_r = qr_prim_rsx_vf(j, k, l + 1, 1)
13789 gamma_r = gammas(1)
13790 pi_inf_r = pi_infs(1)
13791 qv_r = qvs(1)
13792 end if
13793
13794 if (viscous) then
13795 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
13796
13797# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13798#if defined(MFC_OpenACC)
13799# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13800!$acc loop seq
13801# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13802#elif defined(MFC_OpenMP)
13803# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13804
13805# 2504 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13806#endif
13807 do i = 1, 2
13808 re_l(i) = dflt_real
13809 re_r(i) = dflt_real
13810
13811 if (re_size(i) > 0) re_l(i) = 0._wp
13812 if (re_size(i) > 0) re_r(i) = 0._wp
13813
13814
13815# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13816#if defined(MFC_OpenACC)
13817# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13818!$acc loop seq
13819# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13820#elif defined(MFC_OpenMP)
13821# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13822
13823# 2512 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13824#endif
13825 do q = 1, re_size(i)
13826 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, eqn_idx%E + re_idx(i, &
13827 & q)))/res_gs(i, q) + re_l(i)
13828 re_r(i) = (1._wp - qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + re_idx(i, &
13829 & q)))/res_gs(i, q) + re_r(i)
13830 end do
13831
13832 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
13833 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
13834 end do
13835 end if
13836 end if
13837
13838 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
13839 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
13840
13841 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
13842 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
13843
13844 h_l = (e_l + pres_l)/rho_l
13845 h_r = (e_r + pres_r)/rho_r
13846
13847 if (avg_state == 2) then
13848
13849# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13850#if defined(MFC_OpenACC)
13851# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13852!$acc loop seq
13853# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13854#elif defined(MFC_OpenMP)
13855# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13856
13857# 2536 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13858#endif
13859 do i = 1, nb
13860 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
13861 r0_r(i) = qr_prim_rsx_vf(j, k, l + 1, rs(i))
13862
13863 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
13864 v0_r(i) = qr_prim_rsx_vf(j, k, l + 1, vs(i))
13865 if (.not. polytropic .and. .not. qbmm) then
13866 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
13867 p0_r(i) = qr_prim_rsx_vf(j, k, l + 1, ps(i))
13868 end if
13869 end do
13870
13871 if (.not. qbmm) then
13872 if (adv_n) then
13873 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%n)
13874 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%n)
13875 else
13876 nbub_l = 0._wp
13877 nbub_r = 0._wp
13878
13879# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13880#if defined(MFC_OpenACC)
13881# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13882!$acc loop seq
13883# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13884#elif defined(MFC_OpenMP)
13885# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13886
13887# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13888#endif
13889 do i = 1, nb
13890 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
13891 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
13892 end do
13893
13894 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, eqn_idx%E + num_fluids)/nbub_l
13895 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j, k, l + 1, &
13896 & eqn_idx%E + num_fluids)/nbub_r
13897 end if
13898 else
13899 ! nb stored in 0th moment of first R0 bin in variable conversion module
13900 nbub_l = ql_prim_rsx_vf(j, k, l, eqn_idx%bub%beg)
13901 nbub_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%bub%beg)
13902 end if
13903
13904
13905# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13906#if defined(MFC_OpenACC)
13907# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13908!$acc loop seq
13909# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13910#elif defined(MFC_OpenMP)
13911# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13912
13913# 2572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13914#endif
13915 do i = 1, nb
13916 if (.not. qbmm) then
13917 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
13918 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
13919 end if
13920 end do
13921
13922 if (qbmm) then
13923 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
13924 pbwr3rbar = mom_sp_rsx_vf(j, k, l + 1, 4)
13925
13926 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
13927 r3rbar = mom_sp_rsx_vf(j, k, l + 1, 1)
13928
13929 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
13930 r3v2rbar = mom_sp_rsx_vf(j, k, l + 1, 3)
13931 else
13932 pbwr3lbar = 0._wp
13933 pbwr3rbar = 0._wp
13934
13935 r3lbar = 0._wp
13936 r3rbar = 0._wp
13937
13938 r3v2lbar = 0._wp
13939 r3v2rbar = 0._wp
13940
13941
13942# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13943#if defined(MFC_OpenACC)
13944# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13945!$acc loop seq
13946# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13947#elif defined(MFC_OpenMP)
13948# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13949
13950# 2599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13951#endif
13952 do i = 1, nb
13953 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
13954 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
13955
13956 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
13957 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
13958
13959 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
13960 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
13961 end do
13962 end if
13963
13964 rho_avg = 5.e-1_wp*(rho_l + rho_r)
13965 h_avg = 5.e-1_wp*(h_l + h_r)
13966 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
13967 qv_avg = 5.e-1_wp*(qv_l + qv_r)
13968 vel_avg_rms = 0._wp
13969
13970
13971# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13972#if defined(MFC_OpenACC)
13973# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13974!$acc loop seq
13975# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13976#elif defined(MFC_OpenMP)
13977# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13978
13979# 2618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13980#endif
13981 do i = 1, num_dims
13982 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
13983 end do
13984 end if
13985
13986 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
13987 & c_l, qv_l)
13988
13989 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
13990 & c_r, qv_r)
13991
13992 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
13993 ! variables are placeholders to call the subroutine.
13994 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
13995 & 0._wp, c_avg, qv_avg)
13996
13997 if (viscous) then
13998
13999# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14000#if defined(MFC_OpenACC)
14001# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14002!$acc loop seq
14003# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14004#elif defined(MFC_OpenMP)
14005# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14006
14007# 2636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14008#endif
14009 do i = 1, 2
14010 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
14011 end do
14012 end if
14013
14014 ! Low Mach correction
14015 if (low_mach == 2) then
14016 if (riemann_solver == 1 .or. riemann_solver == 5) then
14017# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14018 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14019# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14020 pcorr = 0._wp
14021# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14022
14023# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14024 if (low_mach == 1) then
14025# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14026 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14027# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14028 end if
14029# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14030 else if (riemann_solver == 2) then
14031# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14032 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14033# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14034 pcorr = 0._wp
14035# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14036
14037# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14038 if (low_mach == 1) then
14039# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14040 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))) &
14041# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14042 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14043# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14044 else if (low_mach == 2) then
14045# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14046 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))))
14047# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14048 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))))
14049# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14050 vel_l(dir_idx(1)) = vel_l_tmp
14051# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14052 vel_r(dir_idx(1)) = vel_r_tmp
14053# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14054 end if
14055# 2644 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14056 end if
14057 end if
14058
14059 if (wave_speeds == 1) then
14060 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
14061 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
14062
14063 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
14064 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) &
14065 & - rho_r*(s_r - vel_r(dir_idx(1))))
14066 else if (wave_speeds == 2) then
14067 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
14068
14069 pres_sr = pres_sl
14070
14071 ! Low Mach correction: Thornber et al. JCP (2008)
14072 ms_l = max(1._wp, &
14073 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
14074 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
14075 ms_r = max(1._wp, &
14076 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
14077 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
14078
14079 s_l = vel_l(dir_idx(1)) - c_l*ms_l
14080 s_r = vel_r(dir_idx(1)) + c_r*ms_r
14081
14082 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
14083 end if
14084
14085 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
14086 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
14087
14088 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
14089 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
14090 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
14091 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
14092 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
14093
14094 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
14095 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
14096 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
14097
14098 ! Low Mach correction
14099 if (low_mach == 1) then
14100 if (riemann_solver == 1 .or. riemann_solver == 5) then
14101# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14102 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14103# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14104 pcorr = 0._wp
14105# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14106
14107# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14108 if (low_mach == 1) then
14109# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14110 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14111# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14112 end if
14113# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14114 else if (riemann_solver == 2) then
14115# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14116 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14117# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14118 pcorr = 0._wp
14119# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14120
14121# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14122 if (low_mach == 1) then
14123# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14124 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))) &
14125# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14126 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14127# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14128 else if (low_mach == 2) then
14129# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14130 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))))
14131# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14132 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))))
14133# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14134 vel_l(dir_idx(1)) = vel_l_tmp
14135# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14136 vel_r(dir_idx(1)) = vel_r_tmp
14137# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14138 end if
14139# 2688 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14140 end if
14141 else
14142 pcorr = 0._wp
14143 end if
14144
14145
14146# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14147#if defined(MFC_OpenACC)
14148# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14149!$acc loop seq
14150# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14151#elif defined(MFC_OpenMP)
14152# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14153
14154# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14155#endif
14156 do i = 1, eqn_idx%cont%end
14157 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
14158 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
14159 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
14160 end do
14161
14162 if (bubbles_euler .and. (num_fluids > 1)) then
14163 ! Kill mass transport @ gas density
14164 flux_rsx_vf(j, k, l, eqn_idx%cont%end) = 0._wp
14165 end if
14166
14167 ! Momentum flux. f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
14168
14169 ! Include p_tilde
14170
14171 if (avg_state == 2) then
14172 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
14173 pres_l = pres_l - alpha_l(num_fluids)*pres_l
14174 else
14175 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - rho_l*r3v2lbar/r3lbar)
14176 end if
14177
14178 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
14179 pres_r = pres_r - alpha_r(num_fluids)*pres_r
14180 else
14181 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - rho_r*r3v2rbar/r3rbar)
14182 end if
14183 end if
14184
14185
14186# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14187#if defined(MFC_OpenACC)
14188# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14189!$acc loop seq
14190# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14191#elif defined(MFC_OpenMP)
14192# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14193
14194# 2723 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14195#endif
14196 do i = 1, num_dims
14197 flux_rsx_vf(j, k, l, &
14198 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
14199 & ) + s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
14200 & *vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_l)) &
14201 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) &
14202 & + s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + (1._wp - dir_flg(dir_idx(i))) &
14203 & *vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*(pres_r)) &
14204 & + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
14205 end do
14206
14207 ! Energy flux. f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
14208 flux_rsx_vf(j, k, l, &
14209 & eqn_idx%E) = xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + s_m*(xi_l*(e_l + (s_s &
14210 & - vel_l(dir_idx(1)))*(rho_l*s_s + (pres_l)/(s_l - vel_l(dir_idx(1))))) - e_l)) &
14211 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)) &
14212 & )*(rho_r*s_s + (pres_r)/(s_r - vel_r(dir_idx(1))))) - e_r)) + (s_m/s_l)*(s_p/s_r) &
14213 & *pcorr*s_s
14214
14215 ! Volume fraction flux
14216
14217# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14218#if defined(MFC_OpenACC)
14219# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14220!$acc loop seq
14221# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14222#elif defined(MFC_OpenMP)
14223# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14224
14225# 2744 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14226#endif
14227 do i = eqn_idx%adv%beg, eqn_idx%adv%end
14228 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
14229 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
14230 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
14231 end do
14232
14233 ! Advection velocity source: interface velocity for volume fraction transport
14234
14235# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14236#if defined(MFC_OpenACC)
14237# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14238!$acc loop seq
14239# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14240#elif defined(MFC_OpenMP)
14241# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14242
14243# 2752 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14244#endif
14245 do i = 1, num_dims
14246 vel_src_rsx_vf(j, k, l, &
14247 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
14248 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
14249
14250 ! IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
14251 end do
14252
14253 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
14254
14255 ! Add advection flux for bubble variables
14256
14257# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14258#if defined(MFC_OpenACC)
14259# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14260!$acc loop seq
14261# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14262#elif defined(MFC_OpenMP)
14263# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14264
14265# 2764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14266#endif
14267 do i = eqn_idx%bub%beg, eqn_idx%bub%end
14268 flux_rsx_vf(j, k, l, i) = xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, &
14269 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
14270 & + xi_p*nbub_r*qr_prim_rsx_vf(j, k, l + 1, i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
14271 end do
14272
14273 if (qbmm) then
14274 flux_rsx_vf(j, k, l, &
14275 & eqn_idx%bub%beg) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
14276 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
14277 end if
14278
14279 if (adv_n) then
14280 flux_rsx_vf(j, k, l, &
14281 & eqn_idx%n) = xi_m*nbub_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
14282 & + xi_p*nbub_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
14283 end if
14284
14285 ! Geometrical source flux for cylindrical coordinates
14286# 2806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14287# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14288 if (grid_geometry == 3) then
14289
14290# 2808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14291#if defined(MFC_OpenACC)
14292# 2808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14293!$acc loop seq
14294# 2808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14295#elif defined(MFC_OpenMP)
14296# 2808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14297
14298# 2808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14299#endif
14300 do i = 1, sys_size
14301 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
14302 end do
14303
14304 flux_gsrc_rsx_vf(j, k, l, &
14305 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1) &
14306 & ) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
14307 & *vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
14308 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
14309 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
14310 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
14311 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
14312 end if
14313# 2823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14314 end do
14315 end do
14316 end do
14317
14318# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14319#if defined(MFC_OpenACC)
14320# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14321!$acc end parallel loop
14322# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14323#elif defined(MFC_OpenMP)
14324# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14325
14326# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14327!$omp end target teams loop
14328# 2826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14329#endif
14330 else
14331 ! 5-equation model (model_eqns=2): mixture total energy, volume fraction advection
14332
14333# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14334
14335# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14336#if defined(MFC_OpenACC)
14337# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14338!$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)
14339# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14340#elif defined(MFC_OpenMP)
14341# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14342
14343# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14344
14345# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14346
14347# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14348!$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)
14349# 2829 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14350#endif
14351# 2838 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14352 do l = is1%beg, is1%end
14353 do k = is2%beg, is2%end
14354 do j = is3%beg, is3%end
14355 vel_l_rms = 0._wp; vel_r_rms = 0._wp
14356 rho_l = 0._wp; rho_r = 0._wp
14357 gamma_l = 0._wp; gamma_r = 0._wp
14358 pi_inf_l = 0._wp; pi_inf_r = 0._wp
14359 qv_l = 0._wp; qv_r = 0._wp
14360 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
14361
14362
14363# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14364#if defined(MFC_OpenACC)
14365# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14366!$acc loop seq
14367# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14368#elif defined(MFC_OpenMP)
14369# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14370
14371# 2848 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14372#endif
14373 do i = 1, num_fluids
14374 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
14375 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
14376 end do
14377
14378
14379# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14380#if defined(MFC_OpenACC)
14381# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14382!$acc loop seq
14383# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14384#elif defined(MFC_OpenMP)
14385# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14386
14387# 2854 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14388#endif
14389 do i = 1, num_dims
14390 vel_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + i)
14391 vel_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + i)
14392 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
14393 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
14394 end do
14395
14396 pres_l = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
14397 pres_r = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
14398
14399 ! Change this by splitting it into the cases present in the bubbles_euler
14400 if (mpp_lim) then
14401
14402# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14403#if defined(MFC_OpenACC)
14404# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14405!$acc loop seq
14406# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14407#elif defined(MFC_OpenMP)
14408# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14409
14410# 2867 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14411#endif
14412 do i = 1, num_fluids
14413 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
14414 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, &
14415 & eqn_idx%E + i)), 1._wp)
14416 qr_prim_rsx_vf(j, k, l + 1, i) = max(0._wp, qr_prim_rsx_vf(j, k, l + 1, i))
14417 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = min(max(0._wp, &
14418 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)), 1._wp)
14419 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
14420 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
14421 end do
14422
14423
14424# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14425#if defined(MFC_OpenACC)
14426# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14427!$acc loop seq
14428# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14429#elif defined(MFC_OpenMP)
14430# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14431
14432# 2879 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14433#endif
14434 do i = 1, num_fluids
14435 ql_prim_rsx_vf(j, k, l, eqn_idx%E + i) = ql_prim_rsx_vf(j, k, l, &
14436 & eqn_idx%E + i)/max(alpha_l_sum, sgm_eps)
14437 qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i) = qr_prim_rsx_vf(j, k, l + 1, &
14438 & eqn_idx%E + i)/max(alpha_r_sum, sgm_eps)
14439 end do
14440 end if
14441
14442
14443# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14444#if defined(MFC_OpenACC)
14445# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14446!$acc loop seq
14447# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14448#elif defined(MFC_OpenMP)
14449# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14450
14451# 2888 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14452#endif
14453 do i = 1, num_fluids
14454 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
14455 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*gammas(i)
14456 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)*pi_infs(i)
14457 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
14458
14459 rho_r = rho_r + qr_prim_rsx_vf(j, k, l + 1, i)
14460 gamma_r = gamma_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*gammas(i)
14461 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)*pi_infs(i)
14462 qv_r = qv_r + qr_prim_rsx_vf(j, k, l + 1, i)*qvs(i)
14463 end do
14464
14465 re_max = 0
14466 if (re_size(1) > 0) re_max = 1
14467 if (re_size(2) > 0) re_max = 2
14468
14469 if (viscous) then
14470
14471# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14472#if defined(MFC_OpenACC)
14473# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14474!$acc loop seq
14475# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14476#elif defined(MFC_OpenMP)
14477# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14478
14479# 2906 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14480#endif
14481 do i = 1, re_max
14482 re_l(i) = 0._wp
14483 re_r(i) = 0._wp
14484
14485
14486# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14487#if defined(MFC_OpenACC)
14488# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14489!$acc loop seq
14490# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14491#elif defined(MFC_OpenMP)
14492# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14493
14494# 2911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14495#endif
14496 do q = 1, re_size(i)
14497 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) + re_l(i)
14498 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) + re_r(i)
14499 end do
14500
14501 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
14502 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
14503 end do
14504 end if
14505
14506 if (chemistry) then
14507 c_sum_yi_phi = 0.0_wp
14508
14509# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14510#if defined(MFC_OpenACC)
14511# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14512!$acc loop seq
14513# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14514#elif defined(MFC_OpenMP)
14515# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14516
14517# 2924 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14518#endif
14519 do i = eqn_idx%species%beg, eqn_idx%species%end
14520 ys_l(i - eqn_idx%species%beg + 1) = ql_prim_rsx_vf(j, k, l, i)
14521 ys_r(i - eqn_idx%species%beg + 1) = qr_prim_rsx_vf(j, k, l + 1, i)
14522 end do
14523
14524 call get_mixture_molecular_weight(ys_l, mw_l)
14525 call get_mixture_molecular_weight(ys_r, mw_r)
14526
14527# 2937 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14528 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
14529 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
14530# 2940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14531
14532 r_gas_l = gas_constant/mw_l
14533 r_gas_r = gas_constant/mw_r
14534
14535 t_l = pres_l/rho_l/r_gas_l
14536 t_r = pres_r/rho_r/r_gas_r
14537
14538 call get_species_specific_heats_r(t_l, cp_il)
14539 call get_species_specific_heats_r(t_r, cp_ir)
14540
14541 if (chem_params%gamma_method == 1) then
14542 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
14543 gamma_il = cp_il/(cp_il - 1.0_wp)
14544 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
14545
14546 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
14547 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
14548 else if (chem_params%gamma_method == 2) then
14549 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
14550 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
14551 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
14552 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
14553 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
14554
14555 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
14556 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
14557 end if
14558
14559 call get_mixture_energy_mass(t_l, ys_l, e_l)
14560 call get_mixture_energy_mass(t_r, ys_r, e_r)
14561
14562 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
14563 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
14564 h_l = (e_l + pres_l)/rho_l
14565 h_r = (e_r + pres_r)/rho_r
14566 else
14567 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
14568 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
14569
14570 h_l = (e_l + pres_l)/rho_l
14571 h_r = (e_r + pres_r)/rho_r
14572 end if
14573
14574 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
14575 if (hypoelasticity) then
14576
14577# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14578#if defined(MFC_OpenACC)
14579# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14580!$acc loop seq
14581# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14582#elif defined(MFC_OpenMP)
14583# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14584
14585# 2985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14586#endif
14587 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
14588 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
14589 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
14590 end do
14591 g_l = 0._wp
14592 g_r = 0._wp
14593
14594# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14595#if defined(MFC_OpenACC)
14596# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14597!$acc loop seq
14598# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14599#elif defined(MFC_OpenMP)
14600# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14601
14602# 2992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14603#endif
14604 do i = 1, num_fluids
14605 g_l = g_l + alpha_l(i)*gs_rs(i)
14606 g_r = g_r + alpha_r(i)*gs_rs(i)
14607 end do
14608
14609# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14610#if defined(MFC_OpenACC)
14611# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14612!$acc loop seq
14613# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14614#elif defined(MFC_OpenMP)
14615# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14616
14617# 2997 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14618#endif
14619 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
14620 ! Elastic contribution to energy if G large enough
14621 if ((g_l > verysmall) .and. (g_r > verysmall)) then
14622 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
14623 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
14624 ! Additional terms in 2D and 3D
14625 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
14626 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
14627 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
14628 end if
14629 end if
14630 end do
14631 end if
14632
14633 ! Hyperelastic stress contribution: strain energy added to total energy
14634 if (hyperelasticity) then
14635
14636# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14637#if defined(MFC_OpenACC)
14638# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14639!$acc loop seq
14640# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14641#elif defined(MFC_OpenMP)
14642# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14643
14644# 3014 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14645#endif
14646 do i = 1, num_dims
14647 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%xi%beg - 1 + i)
14648 xi_field_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%beg - 1 + i)
14649 end do
14650 g_l = 0._wp
14651 g_r = 0._wp
14652
14653# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14654#if defined(MFC_OpenACC)
14655# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14656!$acc loop seq
14657# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14658#elif defined(MFC_OpenMP)
14659# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14660
14661# 3021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14662#endif
14663 do i = 1, num_fluids
14664 ! Mixture left and right shear modulus
14665 g_l = g_l + alpha_l(i)*gs_rs(i)
14666 g_r = g_r + alpha_r(i)*gs_rs(i)
14667 end do
14668 ! Elastic contribution to energy if G large enough
14669 if (g_l > verysmall .and. g_r > verysmall) then
14670 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, eqn_idx%xi%end + 1)
14671 e_r = e_r + g_r*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%xi%end + 1)
14672 end if
14673
14674# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14675#if defined(MFC_OpenACC)
14676# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14677!$acc loop seq
14678# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14679#elif defined(MFC_OpenMP)
14680# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14681
14682# 3032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14683#endif
14684 do i = 1, b_size - 1
14685 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%stress%beg - 1 + i)
14686 tau_e_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%stress%beg - 1 + i)
14687 end do
14688 end if
14689
14690 h_l = (e_l + pres_l)/rho_l
14691 h_r = (e_r + pres_r)/rho_r
14692
14693 if (avg_state == 1) then
14694# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14695 rho_avg = sqrt(rho_l*rho_r)
14696# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14697
14698# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14699 vel_avg_rms = 0._wp
14700# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14701
14702# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14703
14704# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14705#if defined(MFC_OpenACC)
14706# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14707!$acc loop seq
14708# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14709#elif defined(MFC_OpenMP)
14710# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14711
14712# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14713#endif
14714# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14715 do i = 1, num_vels
14716# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14717 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
14718# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14719 end do
14720# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14721
14722# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14723 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/(sqrt(rho_l) + sqrt(rho_r))
14724# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14725
14726# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14727 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/(sqrt(rho_l) + sqrt(rho_r))
14728# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14729
14730# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14731 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
14732# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14733
14734# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14735 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/(sqrt(rho_l) + sqrt(rho_r))
14736# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14737
14738# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14739 if (chemistry) then
14740# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14741 eps = 0.001_wp
14742# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14743 call get_species_enthalpies_rt(t_l, h_il)
14744# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14745 call get_species_enthalpies_rt(t_r, h_ir)
14746# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14747 h_il = h_il*gas_constant/molecular_weights*t_l
14748# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14749 h_ir = h_ir*gas_constant/molecular_weights*t_r
14750# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14751 call get_species_specific_heats_r(t_l, cp_il)
14752# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14753 call get_species_specific_heats_r(t_r, cp_ir)
14754# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14755
14756# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14757 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
14758# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14759 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
14760# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14761 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
14762# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14763 if (abs(t_l - t_r) < eps) then
14764# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14765 ! Case when T_L and T_R are very close
14766# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14767 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
14768# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14769 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) &
14770# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14771 & - gas_constant/molecular_weights(:)))
14772# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14773 else
14774# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14775 ! Normal calculation when T_L and T_R are sufficiently different
14776# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14777 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
14778# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14779 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
14780# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14781 end if
14782# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14783 gamma_avg = cp_avg/cv_avg
14784# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14785
14786# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14787 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
14788# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14789 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
14790# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14791 end if
14792# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14793 end if
14794# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14795
14796# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14797 if (avg_state == 2) then
14798# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14799 rho_avg = 5.e-1_wp*(rho_l + rho_r)
14800# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14801 vel_avg_rms = 0._wp
14802# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14803
14804# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14805#if defined(MFC_OpenACC)
14806# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14807!$acc loop seq
14808# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14809#elif defined(MFC_OpenMP)
14810# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14811
14812# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14813#endif
14814# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14815 do i = 1, num_vels
14816# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14817 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
14818# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14819 end do
14820# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14821
14822# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14823 h_avg = 5.e-1_wp*(h_l + h_r)
14824# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14825 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
14826# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14827 qv_avg = 5.e-1_wp*(qv_l + qv_r)
14828# 3042 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14829 end if
14830
14831 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, vel_l_rms, 0._wp, &
14832 & c_l, qv_l)
14833
14834 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, vel_r_rms, 0._wp, &
14835 & c_r, qv_r)
14836
14837 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
14838 ! variables are placeholders to call the subroutine.
14839 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, vel_avg_rms, &
14840 & c_sum_yi_phi, c_avg, qv_avg)
14841
14842 if (viscous) then
14843 if (chemistry) then
14844 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
14845 end if
14846
14847# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14848#if defined(MFC_OpenACC)
14849# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14850!$acc loop seq
14851# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14852#elif defined(MFC_OpenMP)
14853# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14854
14855# 3059 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14856#endif
14857 do i = 1, 2
14858 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
14859 end do
14860 end if
14861
14862 ! Low Mach correction
14863 if (low_mach == 2) then
14864 if (riemann_solver == 1 .or. riemann_solver == 5) then
14865# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14866 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14867# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14868 pcorr = 0._wp
14869# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14870
14871# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14872 if (low_mach == 1) then
14873# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14874 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14875# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14876 end if
14877# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14878 else if (riemann_solver == 2) then
14879# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14880 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14881# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14882 pcorr = 0._wp
14883# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14884
14885# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14886 if (low_mach == 1) then
14887# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14888 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))) &
14889# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14890 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14891# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14892 else if (low_mach == 2) then
14893# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14894 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))))
14895# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14896 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))))
14897# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14898 vel_l(dir_idx(1)) = vel_l_tmp
14899# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14900 vel_r(dir_idx(1)) = vel_r_tmp
14901# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14902 end if
14903# 3067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14904 end if
14905 end if
14906
14907 if (wave_speeds == 1) then
14908 if (elasticity) then
14909 ! Elastic wave speed, Rodriguez et al. JCP (2019)
14910 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) &
14911 & ))/rho_l), &
14912 & vel_r(dir_idx(1)) - sqrt(c_r*c_r + (((4._wp*g_r)/3._wp) &
14913 & + tau_e_r(dir_idx_tau(1)))/rho_r))
14914 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) &
14915 & ))/rho_r), &
14916 & vel_l(dir_idx(1)) + sqrt(c_l*c_l + (((4._wp*g_l)/3._wp) &
14917 & + tau_e_l(dir_idx_tau(1)))/rho_l))
14918 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + tau_e_l(dir_idx_tau(1)) &
14919 & + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1)) &
14920 & *(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r &
14921 & - vel_r(dir_idx(1))))
14922 else
14923 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
14924 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
14925 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) &
14926 & - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l &
14927 & - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
14928 end if
14929 else if (wave_speeds == 2) then
14930 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg*(vel_l(dir_idx(1)) - vel_r(dir_idx(1))))
14931
14932 pres_sr = pres_sl
14933
14934 ! Low Mach correction: Thornber et al. JCP (2008)
14935 ms_l = max(1._wp, &
14936 & sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))*(pres_sl/pres_l - 1._wp) &
14937 & *pres_l/((pres_l + pi_inf_l/(1._wp + gamma_l)))))
14938 ms_r = max(1._wp, &
14939 & sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))*(pres_sr/pres_r - 1._wp) &
14940 & *pres_r/((pres_r + pi_inf_r/(1._wp + gamma_r)))))
14941
14942 s_l = vel_l(dir_idx(1)) - c_l*ms_l
14943 s_r = vel_r(dir_idx(1)) + c_r*ms_r
14944
14945 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + (pres_l - pres_r)/(rho_avg*c_avg))
14946 end if
14947
14948 ! follows Einfeldt et al. s_M/P = min/max(0.,s_L/R)
14949 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
14950
14951 ! goes with q_star_L/R = xi_L/R * (variable) xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
14952 xi_l = (s_l - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
14953 xi_r = (s_r - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
14954 ! xi_L/R - 1 = (s_S - u_L/R)/(s_L/R - s_star): avoids cancellation when xi \approx 1
14955 xi_l_m1 = (s_s - vel_l(dir_idx(1)))/min(s_l - s_s, -sgm_eps)
14956 xi_r_m1 = (s_s - vel_r(dir_idx(1)))/max(s_r - s_s, sgm_eps)
14957
14958 ! goes with numerical velocity in x/y/z directions xi_P/M = 0.5 +/m sgn(0.5,s_star)
14959 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
14960 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
14961
14962 ! Low Mach correction
14963 if (low_mach == 1) then
14964 if (riemann_solver == 1 .or. riemann_solver == 5) then
14965# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14966 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14967# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14968 pcorr = 0._wp
14969# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14970
14971# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14972 if (low_mach == 1) then
14973# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14974 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14975# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14976 end if
14977# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14978 else if (riemann_solver == 2) then
14979# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14980 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14981# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14982 pcorr = 0._wp
14983# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14984
14985# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14986 if (low_mach == 1) then
14987# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14988 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))) &
14989# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14990 & /(rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))*(zcoef - 1._wp)
14991# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14992 else if (low_mach == 2) then
14993# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14994 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))))
14995# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14996 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))))
14997# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14998 vel_l(dir_idx(1)) = vel_l_tmp
14999# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15000 vel_r(dir_idx(1)) = vel_r_tmp
15001# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15002 end if
15003# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15004 end if
15005 else
15006 pcorr = 0._wp
15007 end if
15008
15009 ! COMPUTING THE HLLC FLUXES MASS FLUX.
15010
15011# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15012#if defined(MFC_OpenACC)
15013# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15014!$acc loop seq
15015# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15016#elif defined(MFC_OpenMP)
15017# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15018
15019# 3133 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15020#endif
15021 do i = 1, eqn_idx%cont%end
15022 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
15023 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
15024 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
15025 end do
15026
15027 ! MOMENTUM FLUX. f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w) identity:
15028 ! xi*(dir_flg*s_S+(1-dir_flg)*u_i)-u_i = (dir_flg*s_L/R+(1-dir_flg)*u_i)*xi_m1
15029
15030# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15031#if defined(MFC_OpenACC)
15032# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15033!$acc loop seq
15034# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15035#elif defined(MFC_OpenMP)
15036# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15037
15038# 3142 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15039#endif
15040 do i = 1, num_dims
15041 flux_rsx_vf(j, k, l, &
15042 & eqn_idx%cont%end + dir_idx(i)) = xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(i) &
15043 & ) + s_m*(dir_flg(dir_idx(i))*s_l + (1._wp - dir_flg(dir_idx(i))) &
15044 & *vel_l(dir_idx(i)))*xi_l_m1) + dir_flg(dir_idx(i))*(pres_l)) &
15045 & + xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(i)) + s_p*(dir_flg(dir_idx(i)) &
15046 & *s_r + (1._wp - dir_flg(dir_idx(i)))*vel_r(dir_idx(i)))*xi_r_m1) &
15047 & + dir_flg(dir_idx(i))*(pres_r)) + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
15048 end do
15049
15050 ! ENERGY FLUX. f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
15051 ! xi*(E+expr)-E = E*xi_m1 + xi*expr avoids E*(xi-1) cancellation
15052 flux_rsx_vf(j, k, l, &
15053 & 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 &
15054 & - vel_l(dir_idx(1)))*(rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1)))))) &
15055 & + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + s_p*(e_r*xi_r_m1 + xi_r*(s_s &
15056 & - vel_r(dir_idx(1)))*(rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1)))))) + (s_m/s_l) &
15057 & *(s_p/s_r)*pcorr*s_s
15058
15059 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
15060 if (elasticity) then
15061 flux_ene_e = 0._wp
15062
15063# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15064#if defined(MFC_OpenACC)
15065# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15066!$acc loop seq
15067# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15068#elif defined(MFC_OpenMP)
15069# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15070
15071# 3165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15072#endif
15073 do i = 1, num_dims
15074 ! MOMENTUM ELASTIC FLUX.
15075 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i)) = flux_rsx_vf(j, k, l, &
15076 & eqn_idx%cont%end + dir_idx(i)) - xi_m*tau_e_l(dir_idx_tau(i)) &
15077 & - xi_p*tau_e_r(dir_idx_tau(i))
15078 ! ENERGY ELASTIC FLUX.
15079 flux_ene_e = flux_ene_e - xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) &
15080 & + s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i)) &
15081 & /(s_l - vel_l(i)))))) - xi_p*(vel_r(dir_idx(i)) &
15082 & *tau_e_r(dir_idx_tau(i)) + s_p*(xi_r*((s_s - vel_r(i)) &
15083 & *(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
15084 end do
15085 flux_rsx_vf(j, k, l, eqn_idx%E) = flux_rsx_vf(j, k, l, eqn_idx%E) + flux_ene_e
15086 end if
15087
15088 ! HYPOELASTIC STRESS EVOLUTION FLUX.
15089 if (hypoelasticity) then
15090
15091# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15092#if defined(MFC_OpenACC)
15093# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15094!$acc loop seq
15095# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15096#elif defined(MFC_OpenMP)
15097# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15098
15099# 3183 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15100#endif
15101 do i = 1, eqn_idx%stress%end - eqn_idx%stress%beg + 1
15102 flux_rsx_vf(j, k, l, &
15103 & eqn_idx%stress%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) &
15104 & - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + xi_p*(s_s/(s_r - s_s)) &
15105 & *(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
15106 end do
15107 end if
15108
15109 ! VOLUME FRACTION FLUX.
15110
15111# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15112#if defined(MFC_OpenACC)
15113# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15114!$acc loop seq
15115# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15116#elif defined(MFC_OpenMP)
15117# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15118
15119# 3193 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15120#endif
15121 do i = eqn_idx%adv%beg, eqn_idx%adv%end
15122 flux_rsx_vf(j, k, l, i) = xi_m*ql_prim_rsx_vf(j, k, l, &
15123 & i)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) + xi_p*qr_prim_rsx_vf(j, k, l + 1, &
15124 & i)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
15125 end do
15126
15127 ! VOLUME FRACTION SOURCE FLUX.
15128
15129# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15130#if defined(MFC_OpenACC)
15131# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15132!$acc loop seq
15133# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15134#elif defined(MFC_OpenMP)
15135# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15136
15137# 3201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15138#endif
15139 do i = 1, num_dims
15140 vel_src_rsx_vf(j, k, l, &
15141 & dir_idx(i)) = xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*s_m*xi_l_m1) &
15142 & + xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*s_p*xi_r_m1)
15143 end do
15144
15145 ! COLOR FUNCTION FLUX
15146 if (surface_tension) then
15147 flux_rsx_vf(j, k, l, eqn_idx%c) = xi_m*ql_prim_rsx_vf(j, k, l, &
15148 & eqn_idx%c)*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
15149 & + xi_p*qr_prim_rsx_vf(j, k, l + 1, eqn_idx%c)*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
15150 end if
15151
15152 ! Hyperelastic reference map flux for material deformation tracking
15153 if (hyperelasticity) then
15154
15155# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15156#if defined(MFC_OpenACC)
15157# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15158!$acc loop seq
15159# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15160#elif defined(MFC_OpenMP)
15161# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15162
15163# 3217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15164#endif
15165 do i = 1, num_dims
15166 flux_rsx_vf(j, k, l, &
15167 & eqn_idx%xi%beg - 1 + i) = xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
15168 & - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + xi_p*(s_s/(s_r - s_s)) &
15169 & *(s_r*rho_r*xi_field_r(i) - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
15170 end do
15171 end if
15172
15173 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = vel_src_rsx_vf(j, k, l, dir_idx(1))
15174
15175 if (chemistry) then
15176
15177# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15178#if defined(MFC_OpenACC)
15179# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15180!$acc loop seq
15181# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15182#elif defined(MFC_OpenMP)
15183# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15184
15185# 3229 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15186#endif
15187 do i = eqn_idx%species%beg, eqn_idx%species%end
15188 y_l = ql_prim_rsx_vf(j, k, l, i)
15189 y_r = qr_prim_rsx_vf(j, k, l + 1, i)
15190
15191 flux_rsx_vf(j, k, l, &
15192 & i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*xi_l_m1) &
15193 & + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*xi_r_m1)
15194 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
15195 end do
15196 end if
15197
15198 ! Geometrical source flux for cylindrical coordinates
15199# 3264 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15200# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15201 if (grid_geometry == 3) then
15202
15203# 3266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15204#if defined(MFC_OpenACC)
15205# 3266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15206!$acc loop seq
15207# 3266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15208#elif defined(MFC_OpenMP)
15209# 3266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15210
15211# 3266 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15212#endif
15213 do i = 1, sys_size
15214 flux_gsrc_rsx_vf(j, k, l, i) = 0._wp
15215 end do
15216
15217 flux_gsrc_rsx_vf(j, k, l, &
15218 & eqn_idx%mom%beg + 1) = -xi_m*(rho_l*(vel_l(dir_idx(1))*vel_l(dir_idx(1) &
15219 & ) + s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
15220 & *vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
15221 & - xi_p*(rho_r*(vel_r(dir_idx(1))*vel_r(dir_idx(1)) &
15222 & + s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + (1._wp - dir_flg(dir_idx(1))) &
15223 & *vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
15224 flux_gsrc_rsx_vf(j, k, l, eqn_idx%mom%end) = flux_rsx_vf(j, k, l, eqn_idx%mom%beg + 1)
15225 end if
15226# 3281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15227 end do
15228 end do
15229 end do
15230
15231# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15232#if defined(MFC_OpenACC)
15233# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15234!$acc end parallel loop
15235# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15236#elif defined(MFC_OpenMP)
15237# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15238
15239# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15240!$omp end target teams loop
15241# 3284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15242#endif
15243 end if
15244 end if
15245# 3288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15246 ! Computing HLLC flux and source flux for Euler system of equations
15247
15248 if (viscous) then
15249 if (weno_re_flux) then
15250 call s_compute_viscous_source_flux(ql_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15251 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15252 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15253 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15254 & qr_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15255 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15256 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15257 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, &
15258 & iy, iz)
15259 else
15260 call s_compute_viscous_source_flux(q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15261 & dql_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15262 & dql_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15263 & dql_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15264 & q_prim_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15265 & dqr_prim_dx_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15266 & dqr_prim_dy_vf(eqn_idx%mom%beg:eqn_idx%mom%end), &
15267 & dqr_prim_dz_vf(eqn_idx%mom%beg:eqn_idx%mom%end), flux_src_vf, norm_dir, ix, &
15268 & iy, iz)
15269 end if
15270 end if
15271
15272 if (surface_tension) then
15273 call s_compute_capillary_source_flux(vel_src_rsx_vf, flux_src_vf, norm_dir, isx, isy, isz)
15274 end if
15275
15276 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
15277
15278 end subroutine s_hllc_riemann_solver
15279
15280 !> HLLD Riemann solver for MHD, Miyoshi & Kusano JCP (2005)
15281 subroutine s_hlld_riemann_solver(qL_prim_rsx_vf, dqL_prim_dx_vf, dqL_prim_dy_vf, &
15282
15283 & 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, &
15284 & flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
15285
15286 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: ql_prim_rsx_vf, qr_prim_rsx_vf
15287 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, dql_prim_dy_vf, &
15288 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
15289
15290 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
15291 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
15292 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
15293 integer, intent(in) :: norm_dir
15294 type(int_bounds_info), intent(in) :: ix, iy, iz
15295
15296 ! Local variables:
15297
15298# 3343 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15299 real(wp), dimension(num_fluids) :: alpha_l, alpha_r, alpha_rho_l, alpha_rho_r
15300# 3345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15301 type(riemann_states_vec3) :: vel
15302 type(riemann_states) :: rho, pres, e, h_no_mag
15303 type(riemann_states) :: gamma, pi_inf, qv
15304 type(riemann_states) :: vel_rms
15305 type(riemann_states_vec3) :: b
15306 type(riemann_states) :: c, c_fast, pres_mag
15307
15308 ! HLLD speeds and intermediate state variables:
15309 real(wp) :: s_l, s_r, s_m, s_starl, s_starr
15310 real(wp) :: ptot_l, ptot_r, p_star, rhol_star, rhor_star, e_starl, e_starr
15311 real(wp), dimension(7) :: u_l, u_r, u_starl, u_starr, u_doublel, u_doubler
15312 real(wp), dimension(7) :: f_l, f_r, f_starl, f_starr, f_hlld
15313
15314 ! 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
15315 ! normal velocity, and x is the normal direction Note: Bx is omitted as the magnetic flux is always zero in the normal
15316 ! direction
15317
15318 real(wp) :: sqrt_rhol_star, sqrt_rhor_star, denom_ds, sign_bx
15319 real(wp) :: vl_star, vr_star, wl_star, wr_star
15320 real(wp) :: v_double, w_double, by_double, bz_double, e_doublel, e_doubler, e_double
15321 integer :: i, j, k, l
15322
15323 call s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, &
15324 & qr_prim_rsx_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
15325
15326 call s_initialize_riemann_solver(flux_src_vf, norm_dir)
15327
15328# 3376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15329# 3377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15330# 3378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15331 if (norm_dir == 1) then
15332
15333# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15334
15335# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15336#if defined(MFC_OpenACC)
15337# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15338!$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)
15339# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15340#elif defined(MFC_OpenMP)
15341# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15342
15343# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15344
15345# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15346
15347# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15348!$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)
15349# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15350#endif
15351# 3385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15352 do l = is3%beg, is3%end
15353 do k = is2%beg, is2%end
15354 do j = is1%beg, is1%end
15355 ! (1) Extract the left/right primitive states
15356 do i = 1, eqn_idx%cont%end
15357 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
15358 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
15359 end do
15360
15361 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
15362 do i = 1, num_vels
15363 vel%L(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i))
15364 vel%R(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%cont%end + dir_idx(i))
15365 end do
15366
15367 vel_rms%L = sum(vel%L**2._wp)
15368 vel_rms%R = sum(vel%R**2._wp)
15369
15370 do i = 1, num_fluids
15371 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
15372 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E + i)
15373 end do
15374
15375 pres%L = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
15376 pres%R = qr_prim_rsx_vf(j + 1, k, l, eqn_idx%E)
15377
15378 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
15379 if (mhd) then
15380 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
15381 b%L = [bx0, ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg), ql_prim_rsx_vf(j, k, l, &
15382 & eqn_idx%B%beg + 1)]
15383 b%R = [bx0, qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg), qr_prim_rsx_vf(j + 1, k, l, &
15384 & eqn_idx%B%beg + 1)]
15385 else ! 2D/3D: Bx, By, Bz as variables
15386 b%L = [ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1), ql_prim_rsx_vf(j, k, l, &
15387 & eqn_idx%B%beg + dir_idx(2) - 1), ql_prim_rsx_vf(j, k, l, &
15388 & eqn_idx%B%beg + dir_idx(3) - 1)]
15389 b%R = [qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + dir_idx(1) - 1), &
15390 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + dir_idx(2) - 1), &
15391 & qr_prim_rsx_vf(j + 1, k, l, eqn_idx%B%beg + dir_idx(3) - 1)]
15392 end if
15393 end if
15394
15395 ! Sum properties of all fluid components
15396 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
15397 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
15398
15399# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15400#if defined(MFC_OpenACC)
15401# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15402!$acc loop seq
15403# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15404#elif defined(MFC_OpenMP)
15405# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15406
15407# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15408#endif
15409 do i = 1, num_fluids
15410 rho%L = rho%L + alpha_rho_l(i)
15411 gamma%L = gamma%L + alpha_l(i)*gammas(i)
15412 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
15413 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
15414
15415 rho%R = rho%R + alpha_rho_r(i)
15416 gamma%R = gamma%R + alpha_r(i)*gammas(i)
15417 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
15418 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
15419 end do
15420
15421 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
15422 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
15423 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
15424 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
15425 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
15426 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
15427 h_no_mag%R = (e%R + pres%R - pres_mag%R)/rho%R
15428
15429 ! (2) Compute fast wave speeds
15430 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, &
15431 & 0._wp, c%L, qv%L)
15432 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, &
15433 & 0._wp, c%R, qv%R)
15434 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
15435 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
15436
15437 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
15438 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
15439 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
15440
15441 ptot_l = pres%L + pres_mag%L
15442 ptot_r = pres%R + pres_mag%R
15443
15444 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 &
15445 & - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
15446
15447 ! (4) Compute star state variables
15448 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
15449 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
15450 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
15451 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
15452 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
15453
15454 ! (5) Compute left/right state vectors and fluxes
15455 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
15456 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
15457 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
15458 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
15459
15460 ! Compute the left/right fluxes
15461 f_l(1) = u_l(2)
15462 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
15463 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
15464 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
15465 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))
15466
15467 f_r(1) = u_r(2)
15468 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
15469 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
15470 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
15471 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))
15472 ! HLLD star-state fluxes via HLL jump relation
15473 f_starl = f_l + s_l*(u_starl - u_l)
15474 f_starr = f_r + s_r*(u_starr - u_r)
15475 ! Alfven wave speeds bounding the rotational discontinuities
15476 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
15477 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
15478 ! HLLD double-star (intermediate) states across rotational discontinuities
15479 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
15480 vl_star = vel%L(2); wl_star = vel%L(3)
15481 vr_star = vel%R(2); wr_star = vel%R(3)
15482
15483 ! (6) Compute the double-star states [Miyoshi Eqns. (59)-(62)]
15484 denom_ds = sqrt_rhol_star + sqrt_rhor_star
15485 sign_bx = sign(1._wp, b%L(1))
15486 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
15487 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
15488 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star &
15489 & - vl_star)*sign_bx)/denom_ds
15490 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star &
15491 & - wl_star)*sign_bx)/denom_ds
15492
15493 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double &
15494 & + w_double*bz_double))*sign_bx
15495 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double &
15496 & + w_double*bz_double))*sign_bx
15497 e_double = 0.5_wp*(e_doublel + e_doubler)
15498
15499 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, &
15500 & e_double]
15501 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, &
15502 & e_double]
15503
15504 ! Select HLLD flux region
15505 if (0.0_wp <= s_l) then
15506 f_hlld = f_l
15507 else if (0.0_wp <= s_starl) then
15508 f_hlld = f_l + s_l*(u_starl - u_l)
15509 else if (0.0_wp <= s_m) then
15510 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
15511 else if (0.0_wp <= s_starr) then
15512 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
15513 else if (0.0_wp <= s_r) then
15514 f_hlld = f_r + s_r*(u_starr - u_r)
15515 else
15516 f_hlld = f_r
15517 end if
15518
15519 ! (12) Write HLLD flux to output arrays
15520 flux_rsx_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
15521 ! Momentum
15522 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(2)
15523 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(3)
15524 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(4)
15525 ! Magnetic field
15526 if (n == 0) then
15527 flux_rsx_vf(j, k, l, eqn_idx%B%beg) = f_hlld(5)
15528 flux_rsx_vf(j, k, l, eqn_idx%B%beg + 1) = f_hlld(6)
15529 else
15530 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1) = 0._wp
15531 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(2) - 1) = f_hlld(5)
15532 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(3) - 1) = f_hlld(6)
15533 end if
15534 ! Energy
15535 flux_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(7)
15536 ! Volume fractions
15537
15538# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15539#if defined(MFC_OpenACC)
15540# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15541!$acc loop seq
15542# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15543#elif defined(MFC_OpenMP)
15544# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15545
15546# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15547#endif
15548 do i = eqn_idx%adv%beg, eqn_idx%adv%end
15549 flux_rsx_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
15550 end do
15551
15552 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
15553 end do
15554 end do
15555 end do
15556
15557# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15558#if defined(MFC_OpenACC)
15559# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15560!$acc end parallel loop
15561# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15562#elif defined(MFC_OpenMP)
15563# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15564
15565# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15566!$omp end target teams loop
15567# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15568#endif
15569 end if
15570# 3376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15571# 3377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15572# 3378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15573 if (norm_dir == 2) then
15574
15575# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15576
15577# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15578#if defined(MFC_OpenACC)
15579# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15580!$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)
15581# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15582#elif defined(MFC_OpenMP)
15583# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15584
15585# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15586
15587# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15588
15589# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15590!$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)
15591# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15592#endif
15593# 3385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15594 do l = is3%beg, is3%end
15595 do k = is1%beg, is1%end
15596 do j = is2%beg, is2%end
15597 ! (1) Extract the left/right primitive states
15598 do i = 1, eqn_idx%cont%end
15599 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
15600 alpha_rho_r(i) = qr_prim_rsx_vf(j, k + 1, l, i)
15601 end do
15602
15603 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
15604 do i = 1, num_vels
15605 vel%L(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i))
15606 vel%R(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%cont%end + dir_idx(i))
15607 end do
15608
15609 vel_rms%L = sum(vel%L**2._wp)
15610 vel_rms%R = sum(vel%R**2._wp)
15611
15612 do i = 1, num_fluids
15613 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
15614 alpha_r(i) = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E + i)
15615 end do
15616
15617 pres%L = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
15618 pres%R = qr_prim_rsx_vf(j, k + 1, l, eqn_idx%E)
15619
15620 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
15621 if (mhd) then
15622 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
15623 b%L = [bx0, ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg), ql_prim_rsx_vf(j, k, l, &
15624 & eqn_idx%B%beg + 1)]
15625 b%R = [bx0, qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg), qr_prim_rsx_vf(j, k + 1, l, &
15626 & eqn_idx%B%beg + 1)]
15627 else ! 2D/3D: Bx, By, Bz as variables
15628 b%L = [ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1), ql_prim_rsx_vf(j, k, l, &
15629 & eqn_idx%B%beg + dir_idx(2) - 1), ql_prim_rsx_vf(j, k, l, &
15630 & eqn_idx%B%beg + dir_idx(3) - 1)]
15631 b%R = [qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + dir_idx(1) - 1), &
15632 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + dir_idx(2) - 1), &
15633 & qr_prim_rsx_vf(j, k + 1, l, eqn_idx%B%beg + dir_idx(3) - 1)]
15634 end if
15635 end if
15636
15637 ! Sum properties of all fluid components
15638 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
15639 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
15640
15641# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15642#if defined(MFC_OpenACC)
15643# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15644!$acc loop seq
15645# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15646#elif defined(MFC_OpenMP)
15647# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15648
15649# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15650#endif
15651 do i = 1, num_fluids
15652 rho%L = rho%L + alpha_rho_l(i)
15653 gamma%L = gamma%L + alpha_l(i)*gammas(i)
15654 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
15655 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
15656
15657 rho%R = rho%R + alpha_rho_r(i)
15658 gamma%R = gamma%R + alpha_r(i)*gammas(i)
15659 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
15660 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
15661 end do
15662
15663 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
15664 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
15665 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
15666 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
15667 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
15668 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
15669 h_no_mag%R = (e%R + pres%R - pres_mag%R)/rho%R
15670
15671 ! (2) Compute fast wave speeds
15672 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, &
15673 & 0._wp, c%L, qv%L)
15674 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, &
15675 & 0._wp, c%R, qv%R)
15676 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
15677 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
15678
15679 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
15680 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
15681 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
15682
15683 ptot_l = pres%L + pres_mag%L
15684 ptot_r = pres%R + pres_mag%R
15685
15686 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 &
15687 & - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
15688
15689 ! (4) Compute star state variables
15690 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
15691 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
15692 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
15693 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
15694 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
15695
15696 ! (5) Compute left/right state vectors and fluxes
15697 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
15698 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
15699 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
15700 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
15701
15702 ! Compute the left/right fluxes
15703 f_l(1) = u_l(2)
15704 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
15705 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
15706 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
15707 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))
15708
15709 f_r(1) = u_r(2)
15710 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
15711 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
15712 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
15713 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))
15714 ! HLLD star-state fluxes via HLL jump relation
15715 f_starl = f_l + s_l*(u_starl - u_l)
15716 f_starr = f_r + s_r*(u_starr - u_r)
15717 ! Alfven wave speeds bounding the rotational discontinuities
15718 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
15719 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
15720 ! HLLD double-star (intermediate) states across rotational discontinuities
15721 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
15722 vl_star = vel%L(2); wl_star = vel%L(3)
15723 vr_star = vel%R(2); wr_star = vel%R(3)
15724
15725 ! (6) Compute the double-star states [Miyoshi Eqns. (59)-(62)]
15726 denom_ds = sqrt_rhol_star + sqrt_rhor_star
15727 sign_bx = sign(1._wp, b%L(1))
15728 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
15729 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
15730 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star &
15731 & - vl_star)*sign_bx)/denom_ds
15732 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star &
15733 & - wl_star)*sign_bx)/denom_ds
15734
15735 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double &
15736 & + w_double*bz_double))*sign_bx
15737 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double &
15738 & + w_double*bz_double))*sign_bx
15739 e_double = 0.5_wp*(e_doublel + e_doubler)
15740
15741 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, &
15742 & e_double]
15743 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, &
15744 & e_double]
15745
15746 ! Select HLLD flux region
15747 if (0.0_wp <= s_l) then
15748 f_hlld = f_l
15749 else if (0.0_wp <= s_starl) then
15750 f_hlld = f_l + s_l*(u_starl - u_l)
15751 else if (0.0_wp <= s_m) then
15752 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
15753 else if (0.0_wp <= s_starr) then
15754 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
15755 else if (0.0_wp <= s_r) then
15756 f_hlld = f_r + s_r*(u_starr - u_r)
15757 else
15758 f_hlld = f_r
15759 end if
15760
15761 ! (12) Write HLLD flux to output arrays
15762 flux_rsx_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
15763 ! Momentum
15764 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(2)
15765 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(3)
15766 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(4)
15767 ! Magnetic field
15768 if (n == 0) then
15769 flux_rsx_vf(j, k, l, eqn_idx%B%beg) = f_hlld(5)
15770 flux_rsx_vf(j, k, l, eqn_idx%B%beg + 1) = f_hlld(6)
15771 else
15772 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1) = 0._wp
15773 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(2) - 1) = f_hlld(5)
15774 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(3) - 1) = f_hlld(6)
15775 end if
15776 ! Energy
15777 flux_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(7)
15778 ! Volume fractions
15779
15780# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15781#if defined(MFC_OpenACC)
15782# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15783!$acc loop seq
15784# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15785#elif defined(MFC_OpenMP)
15786# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15787
15788# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15789#endif
15790 do i = eqn_idx%adv%beg, eqn_idx%adv%end
15791 flux_rsx_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
15792 end do
15793
15794 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
15795 end do
15796 end do
15797 end do
15798
15799# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15800#if defined(MFC_OpenACC)
15801# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15802!$acc end parallel loop
15803# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15804#elif defined(MFC_OpenMP)
15805# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15806
15807# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15808!$omp end target teams loop
15809# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15810#endif
15811 end if
15812# 3376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15813# 3377 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15814# 3378 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15815 if (norm_dir == 3) then
15816
15817# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15818
15819# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15820#if defined(MFC_OpenACC)
15821# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15822!$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)
15823# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15824#elif defined(MFC_OpenMP)
15825# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15826
15827# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15828
15829# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15830
15831# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15832!$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)
15833# 3379 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15834#endif
15835# 3385 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15836 do l = is1%beg, is1%end
15837 do k = is2%beg, is2%end
15838 do j = is3%beg, is3%end
15839 ! (1) Extract the left/right primitive states
15840 do i = 1, eqn_idx%cont%end
15841 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
15842 alpha_rho_r(i) = qr_prim_rsx_vf(j, k, l + 1, i)
15843 end do
15844
15845 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
15846 do i = 1, num_vels
15847 vel%L(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(i))
15848 vel%R(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%cont%end + dir_idx(i))
15849 end do
15850
15851 vel_rms%L = sum(vel%L**2._wp)
15852 vel_rms%R = sum(vel%R**2._wp)
15853
15854 do i = 1, num_fluids
15855 alpha_l(i) = ql_prim_rsx_vf(j, k, l, eqn_idx%E + i)
15856 alpha_r(i) = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E + i)
15857 end do
15858
15859 pres%L = ql_prim_rsx_vf(j, k, l, eqn_idx%E)
15860 pres%R = qr_prim_rsx_vf(j, k, l + 1, eqn_idx%E)
15861
15862 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
15863 if (mhd) then
15864 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
15865 b%L = [bx0, ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg), ql_prim_rsx_vf(j, k, l, &
15866 & eqn_idx%B%beg + 1)]
15867 b%R = [bx0, qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg), qr_prim_rsx_vf(j, k, l + 1, &
15868 & eqn_idx%B%beg + 1)]
15869 else ! 2D/3D: Bx, By, Bz as variables
15870 b%L = [ql_prim_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1), ql_prim_rsx_vf(j, k, l, &
15871 & eqn_idx%B%beg + dir_idx(2) - 1), ql_prim_rsx_vf(j, k, l, &
15872 & eqn_idx%B%beg + dir_idx(3) - 1)]
15873 b%R = [qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + dir_idx(1) - 1), &
15874 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + dir_idx(2) - 1), &
15875 & qr_prim_rsx_vf(j, k, l + 1, eqn_idx%B%beg + dir_idx(3) - 1)]
15876 end if
15877 end if
15878
15879 ! Sum properties of all fluid components
15880 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
15881 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
15882
15883# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15884#if defined(MFC_OpenACC)
15885# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15886!$acc loop seq
15887# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15888#elif defined(MFC_OpenMP)
15889# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15890
15891# 3431 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15892#endif
15893 do i = 1, num_fluids
15894 rho%L = rho%L + alpha_rho_l(i)
15895 gamma%L = gamma%L + alpha_l(i)*gammas(i)
15896 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
15897 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
15898
15899 rho%R = rho%R + alpha_rho_r(i)
15900 gamma%R = gamma%R + alpha_r(i)*gammas(i)
15901 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
15902 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
15903 end do
15904
15905 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
15906 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
15907 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
15908 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
15909 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
15910 ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
15911 h_no_mag%R = (e%R + pres%R - pres_mag%R)/rho%R
15912
15913 ! (2) Compute fast wave speeds
15914 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, &
15915 & 0._wp, c%L, qv%L)
15916 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, &
15917 & 0._wp, c%R, qv%R)
15918 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
15919 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
15920
15921 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
15922 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
15923 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
15924
15925 ptot_l = pres%L + pres_mag%L
15926 ptot_r = pres%R + pres_mag%R
15927
15928 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 &
15929 & - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
15930
15931 ! (4) Compute star state variables
15932 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
15933 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
15934 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
15935 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
15936 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
15937
15938 ! (5) Compute left/right state vectors and fluxes
15939 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
15940 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
15941 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
15942 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
15943
15944 ! Compute the left/right fluxes
15945 f_l(1) = u_l(2)
15946 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
15947 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
15948 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
15949 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))
15950
15951 f_r(1) = u_r(2)
15952 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
15953 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
15954 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
15955 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))
15956 ! HLLD star-state fluxes via HLL jump relation
15957 f_starl = f_l + s_l*(u_starl - u_l)
15958 f_starr = f_r + s_r*(u_starr - u_r)
15959 ! Alfven wave speeds bounding the rotational discontinuities
15960 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
15961 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
15962 ! HLLD double-star (intermediate) states across rotational discontinuities
15963 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
15964 vl_star = vel%L(2); wl_star = vel%L(3)
15965 vr_star = vel%R(2); wr_star = vel%R(3)
15966
15967 ! (6) Compute the double-star states [Miyoshi Eqns. (59)-(62)]
15968 denom_ds = sqrt_rhol_star + sqrt_rhor_star
15969 sign_bx = sign(1._wp, b%L(1))
15970 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
15971 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
15972 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star &
15973 & - vl_star)*sign_bx)/denom_ds
15974 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star &
15975 & - wl_star)*sign_bx)/denom_ds
15976
15977 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double &
15978 & + w_double*bz_double))*sign_bx
15979 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double &
15980 & + w_double*bz_double))*sign_bx
15981 e_double = 0.5_wp*(e_doublel + e_doubler)
15982
15983 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, &
15984 & e_double]
15985 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, &
15986 & e_double]
15987
15988 ! Select HLLD flux region
15989 if (0.0_wp <= s_l) then
15990 f_hlld = f_l
15991 else if (0.0_wp <= s_starl) then
15992 f_hlld = f_l + s_l*(u_starl - u_l)
15993 else if (0.0_wp <= s_m) then
15994 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
15995 else if (0.0_wp <= s_starr) then
15996 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
15997 else if (0.0_wp <= s_r) then
15998 f_hlld = f_r + s_r*(u_starr - u_r)
15999 else
16000 f_hlld = f_r
16001 end if
16002
16003 ! (12) Write HLLD flux to output arrays
16004 flux_rsx_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
16005 ! Momentum
16006 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(1)) = f_hlld(2)
16007 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(2)) = f_hlld(3)
16008 flux_rsx_vf(j, k, l, eqn_idx%cont%end + dir_idx(3)) = f_hlld(4)
16009 ! Magnetic field
16010 if (n == 0) then
16011 flux_rsx_vf(j, k, l, eqn_idx%B%beg) = f_hlld(5)
16012 flux_rsx_vf(j, k, l, eqn_idx%B%beg + 1) = f_hlld(6)
16013 else
16014 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(1) - 1) = 0._wp
16015 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(2) - 1) = f_hlld(5)
16016 flux_rsx_vf(j, k, l, eqn_idx%B%beg + dir_idx(3) - 1) = f_hlld(6)
16017 end if
16018 ! Energy
16019 flux_rsx_vf(j, k, l, eqn_idx%E) = f_hlld(7)
16020 ! Volume fractions
16021
16022# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16023#if defined(MFC_OpenACC)
16024# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16025!$acc loop seq
16026# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16027#elif defined(MFC_OpenMP)
16028# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16029
16030# 3560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16031#endif
16032 do i = eqn_idx%adv%beg, eqn_idx%adv%end
16033 flux_rsx_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
16034 end do
16035
16036 flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg) = 0._wp
16037 end do
16038 end do
16039 end do
16040
16041# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16042#if defined(MFC_OpenACC)
16043# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16044!$acc end parallel loop
16045# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16046#elif defined(MFC_OpenMP)
16047# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16048
16049# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16050!$omp end target teams loop
16051# 3569 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16052#endif
16053 end if
16054# 3572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16055
16056 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
16057
16058 end subroutine s_hlld_riemann_solver
16059
16060 !> Initialize the Riemann solvers module
16061 impure subroutine s_initialize_riemann_solvers_module
16062
16063 ! Allocating the variables that will be utilized to formulate the left, right, and average states of the Riemann problem, as
16064 ! well the Riemann problem solution
16065 integer :: i, j
16066
16067#ifdef MFC_DEBUG
16068# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16069 block
16070# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16071 use iso_fortran_env, only: output_unit
16072# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16073
16074# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16075 print *, 'm_riemann_solvers.fpp:3584: ', '@:ALLOCATE(Gs_rs(1:num_fluids))'
16076# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16077
16078# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16079 call flush (output_unit)
16080# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16081 end block
16082# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16083#endif
16084# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16085 allocate (gs_rs(1:num_fluids))
16086# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16087
16088# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16089
16090# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16091#if defined(MFC_OpenACC)
16092# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16093!$acc enter data create(Gs_rs)
16094# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16095#elif defined(MFC_OpenMP)
16096# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16097!$omp target enter data map(always,alloc:Gs_rs)
16098# 3584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16099#endif
16100
16101 do i = 1, num_fluids
16102 gs_rs(i) = fluid_pp(i)%G
16103 end do
16104
16105# 3589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16106#if defined(MFC_OpenACC)
16107# 3589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16108!$acc update device(Gs_rs)
16109# 3589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16110#elif defined(MFC_OpenMP)
16111# 3589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16112!$omp target update to(Gs_rs)
16113# 3589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16114#endif
16115
16116 if (viscous) then
16117#ifdef MFC_DEBUG
16118# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16119 block
16120# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16121 use iso_fortran_env, only: output_unit
16122# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16123
16124# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16125 print *, 'm_riemann_solvers.fpp:3592: ', '@:ALLOCATE(Res_gs(1:2, 1:Re_size_max))'
16126# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16127
16128# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16129 call flush (output_unit)
16130# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16131 end block
16132# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16133#endif
16134# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16135 allocate (res_gs(1:2, 1:re_size_max))
16136# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16137
16138# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16139
16140# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16141#if defined(MFC_OpenACC)
16142# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16143!$acc enter data create(Res_gs)
16144# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16145#elif defined(MFC_OpenMP)
16146# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16147!$omp target enter data map(always,alloc:Res_gs)
16148# 3592 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16149#endif
16150 end if
16151
16152 if (viscous) then
16153 do i = 1, 2
16154 do j = 1, re_size(i)
16155 res_gs(i, j) = fluid_pp(re_idx(i, j))%Re(i)
16156 end do
16157 end do
16158
16159# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16160#if defined(MFC_OpenACC)
16161# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16162!$acc update device(Res_gs, Re_idx, Re_size)
16163# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16164#elif defined(MFC_OpenMP)
16165# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16166!$omp target update to(Res_gs, Re_idx, Re_size)
16167# 3601 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16168#endif
16169 end if
16170
16171
16172# 3604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16173#if defined(MFC_OpenACC)
16174# 3604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16175!$acc enter data copyin(is1, is2, is3, isx, isy, isz)
16176# 3604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16177#elif defined(MFC_OpenMP)
16178# 3604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16179!$omp target enter data map(to:is1, is2, is3, isx, isy, isz)
16180# 3604 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16181#endif
16182
16183 is1%beg = -1; is2%beg = 0; is3%beg = 0
16184 is1%end = m; is2%end = n; is3%end = p
16185
16186#ifdef MFC_DEBUG
16187# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16188 block
16189# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16190 use iso_fortran_env, only: output_unit
16191# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16192
16193# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16194 print *, 'm_riemann_solvers.fpp:3609: ', '@:ALLOCATE(flux_rsx_vf(-1:m, -1:n, -1:p, 1:sys_size))'
16195# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16196
16197# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16198 call flush (output_unit)
16199# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16200 end block
16201# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16202#endif
16203# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16204 allocate (flux_rsx_vf(-1:m, -1:n, -1:p, 1:sys_size))
16205# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16206
16207# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16208
16209# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16210#if defined(MFC_OpenACC)
16211# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16212!$acc enter data create(flux_rsx_vf)
16213# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16214#elif defined(MFC_OpenMP)
16215# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16216!$omp target enter data map(always,alloc:flux_rsx_vf)
16217# 3609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16218#endif
16219#ifdef MFC_DEBUG
16220# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16221 block
16222# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16223 use iso_fortran_env, only: output_unit
16224# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16225
16226# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16227 print *, 'm_riemann_solvers.fpp:3610: ', '@:ALLOCATE(flux_gsrc_rsx_vf(-1:m, -1:n, -1:p, 1:sys_size))'
16228# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16229
16230# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16231 call flush (output_unit)
16232# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16233 end block
16234# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16235#endif
16236# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16237 allocate (flux_gsrc_rsx_vf(-1:m, -1:n, -1:p, 1:sys_size))
16238# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16239
16240# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16241
16242# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16243#if defined(MFC_OpenACC)
16244# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16245!$acc enter data create(flux_gsrc_rsx_vf)
16246# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16247#elif defined(MFC_OpenMP)
16248# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16249!$omp target enter data map(always,alloc:flux_gsrc_rsx_vf)
16250# 3610 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16251#endif
16252#ifdef MFC_DEBUG
16253# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16254 block
16255# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16256 use iso_fortran_env, only: output_unit
16257# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16258
16259# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16260 print *, 'm_riemann_solvers.fpp:3611: ', '@:ALLOCATE(flux_src_rsx_vf(-1:m, -1:n, -1:p, eqn_idx%adv%beg:sys_size))'
16261# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16262
16263# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16264 call flush (output_unit)
16265# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16266 end block
16267# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16268#endif
16269# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16270 allocate (flux_src_rsx_vf(-1:m, -1:n, -1:p, eqn_idx%adv%beg:sys_size))
16271# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16272
16273# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16274
16275# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16276#if defined(MFC_OpenACC)
16277# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16278!$acc enter data create(flux_src_rsx_vf)
16279# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16280#elif defined(MFC_OpenMP)
16281# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16282!$omp target enter data map(always,alloc:flux_src_rsx_vf)
16283# 3611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16284#endif
16285#ifdef MFC_DEBUG
16286# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16287 block
16288# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16289 use iso_fortran_env, only: output_unit
16290# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16291
16292# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16293 print *, 'm_riemann_solvers.fpp:3612: ', '@:ALLOCATE(vel_src_rsx_vf(-1:m, -1:n, -1:p, 1:num_vels))'
16294# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16295
16296# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16297 call flush (output_unit)
16298# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16299 end block
16300# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16301#endif
16302# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16303 allocate (vel_src_rsx_vf(-1:m, -1:n, -1:p, 1:num_vels))
16304# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16305
16306# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16307
16308# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16309#if defined(MFC_OpenACC)
16310# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16311!$acc enter data create(vel_src_rsx_vf)
16312# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16313#elif defined(MFC_OpenMP)
16314# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16315!$omp target enter data map(always,alloc:vel_src_rsx_vf)
16316# 3612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16317#endif
16318 if (qbmm) then
16319#ifdef MFC_DEBUG
16320# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16321 block
16322# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16323 use iso_fortran_env, only: output_unit
16324# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16325
16326# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16327 print *, 'm_riemann_solvers.fpp:3614: ', '@:ALLOCATE(mom_sp_rsx_vf(-1:m+1, -1:n+1, -1:p+1, 1:4))'
16328# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16329
16330# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16331 call flush (output_unit)
16332# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16333 end block
16334# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16335#endif
16336# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16337 allocate (mom_sp_rsx_vf(-1:m+1, -1:n+1, -1:p+1, 1:4))
16338# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16339
16340# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16341
16342# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16343#if defined(MFC_OpenACC)
16344# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16345!$acc enter data create(mom_sp_rsx_vf)
16346# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16347#elif defined(MFC_OpenMP)
16348# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16349!$omp target enter data map(always,alloc:mom_sp_rsx_vf)
16350# 3614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16351#endif
16352 end if
16353
16354 if (viscous) then
16355#ifdef MFC_DEBUG
16356# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16357 block
16358# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16359 use iso_fortran_env, only: output_unit
16360# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16361
16362# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16363 print *, 'm_riemann_solvers.fpp:3618: ', '@:ALLOCATE(Re_avg_rsx_vf(-1:m, -1:n, -1:p, 1:2))'
16364# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16365
16366# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16367 call flush (output_unit)
16368# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16369 end block
16370# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16371#endif
16372# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16373 allocate (re_avg_rsx_vf(-1:m, -1:n, -1:p, 1:2))
16374# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16375
16376# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16377
16378# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16379#if defined(MFC_OpenACC)
16380# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16381!$acc enter data create(Re_avg_rsx_vf)
16382# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16383#elif defined(MFC_OpenMP)
16384# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16385!$omp target enter data map(always,alloc:Re_avg_rsx_vf)
16386# 3618 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16387#endif
16388 end if
16389
16390 end subroutine s_initialize_riemann_solvers_module
16391
16392 !> Populate the left and right Riemann state variable buffers based on boundary conditions
16393 subroutine s_populate_riemann_states_variables_buffers(qL_prim_rsx_vf, dqL_prim_dx_vf, &
16394
16395 & 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)
16396
16397 real(wp), dimension(idwbuff(1)%beg:,idwbuff(2)%beg:,idwbuff(3)%beg:,1:), intent(inout) :: qL_prim_rsx_vf, qR_prim_rsx_vf
16398 type(scalar_field), allocatable, dimension(:), intent(inout) :: dqL_prim_dx_vf, dqR_prim_dx_vf, dqL_prim_dy_vf, &
16399 & dqR_prim_dy_vf, dqL_prim_dz_vf, dqR_prim_dz_vf
16400
16401 integer, intent(in) :: norm_dir
16402 type(int_bounds_info), intent(in) :: ix, iy, iz
16403 integer :: i, j, k, l !< Generic loop iterator
16404
16405 if (norm_dir == 1) then
16406 is1 = ix; is2 = iy; is3 = iz
16407 dir_idx = (/1, 2, 3/); dir_flg = (/1._wp, 0._wp, 0._wp/)
16408 else if (norm_dir == 2) then
16409 is1 = iy; is2 = ix; is3 = iz
16410 dir_idx = (/2, 1, 3/); dir_flg = (/0._wp, 1._wp, 0._wp/)
16411 else
16412 is1 = iz; is2 = iy; is3 = ix
16413 dir_idx = (/3, 1, 2/); dir_flg = (/0._wp, 0._wp, 1._wp/)
16414 end if
16415
16416
16417# 3647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16418#if defined(MFC_OpenACC)
16419# 3647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16420!$acc update device(is1, is2, is3)
16421# 3647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16422#elif defined(MFC_OpenMP)
16423# 3647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16424!$omp target update to(is1, is2, is3)
16425# 3647 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16426#endif
16427
16428 if (elasticity) then
16429 if (norm_dir == 1) then
16430 dir_idx_tau = (/1, 2, 4/)
16431 else if (norm_dir == 2) then
16432 dir_idx_tau = (/3, 2, 5/)
16433 else
16434 dir_idx_tau = (/6, 4, 5/)
16435 end if
16436 end if
16437
16438 isx = ix; isy = iy; isz = iz
16439 ! for stuff in the same module
16440
16441# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16442#if defined(MFC_OpenACC)
16443# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16444!$acc update device(isx, isy, isz)
16445# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16446#elif defined(MFC_OpenMP)
16447# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16448!$omp target update to(isx, isy, isz)
16449# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16450#endif
16451 ! for stuff in different modules
16452
16453# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16454#if defined(MFC_OpenACC)
16455# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16456!$acc update device(dir_idx, dir_flg, dir_idx_tau)
16457# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16458#elif defined(MFC_OpenMP)
16459# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16460!$omp target update to(dir_idx, dir_flg, dir_idx_tau)
16461# 3663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16462#endif
16463
16464 ! Population of Buffers in x-direction
16465 if (norm_dir == 1) then
16466 if (bc_x%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
16467
16468# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16469
16470# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16471#if defined(MFC_OpenACC)
16472# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16473!$acc parallel loop collapse(3) gang vector default(present)
16474# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16475#elif defined(MFC_OpenMP)
16476# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16477
16478# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16479
16480# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16481
16482# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16483!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16484# 3668 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16485#endif
16486 do i = 1, sys_size
16487 do l = is3%beg, is3%end
16488 do k = is2%beg, is2%end
16489 ql_prim_rsx_vf(-1, k, l, i) = qr_prim_rsx_vf(0, k, l, i)
16490 end do
16491 end do
16492 end do
16493
16494# 3676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16495#if defined(MFC_OpenACC)
16496# 3676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16497!$acc end parallel loop
16498# 3676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16499#elif defined(MFC_OpenMP)
16500# 3676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16501
16502# 3676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16503!$omp end target teams loop
16504# 3676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16505#endif
16506
16507 if (viscous) then
16508
16509# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16510
16511# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16512#if defined(MFC_OpenACC)
16513# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16514!$acc parallel loop collapse(3) gang vector default(present)
16515# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16516#elif defined(MFC_OpenMP)
16517# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16518
16519# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16520
16521# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16522
16523# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16524!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16525# 3679 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16526#endif
16527 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16528 do l = isz%beg, isz%end
16529 do k = isy%beg, isy%end
16530 dql_prim_dx_vf(i)%sf(-1, k, l) = dqr_prim_dx_vf(i)%sf(0, k, l)
16531 end do
16532 end do
16533 end do
16534
16535# 3687 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16536#if defined(MFC_OpenACC)
16537# 3687 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16538!$acc end parallel loop
16539# 3687 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16540#elif defined(MFC_OpenMP)
16541# 3687 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16542
16543# 3687 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16544!$omp end target teams loop
16545# 3687 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16546#endif
16547
16548 if (n > 0) then
16549
16550# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16551
16552# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16553#if defined(MFC_OpenACC)
16554# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16555!$acc parallel loop collapse(3) gang vector default(present)
16556# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16557#elif defined(MFC_OpenMP)
16558# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16559
16560# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16561
16562# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16563
16564# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16565!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16566# 3690 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16567#endif
16568 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16569 do l = isz%beg, isz%end
16570 do k = isy%beg, isy%end
16571 dql_prim_dy_vf(i)%sf(-1, k, l) = dqr_prim_dy_vf(i)%sf(0, k, l)
16572 end do
16573 end do
16574 end do
16575
16576# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16577#if defined(MFC_OpenACC)
16578# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16579!$acc end parallel loop
16580# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16581#elif defined(MFC_OpenMP)
16582# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16583
16584# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16585!$omp end target teams loop
16586# 3698 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16587#endif
16588
16589 if (p > 0) then
16590
16591# 3701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16592
16593# 3701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16594#if defined(MFC_OpenACC)
16595# 3701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16596!$acc parallel loop collapse(3) gang vector default(present)
16597# 3701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16598#elif defined(MFC_OpenMP)
16599# 3701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16600
16601# 3701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16602
16603# 3701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16604
16605# 3701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16606!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16607# 3701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16608#endif
16609 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16610 do l = isz%beg, isz%end
16611 do k = isy%beg, isy%end
16612 dql_prim_dz_vf(i)%sf(-1, k, l) = dqr_prim_dz_vf(i)%sf(0, k, l)
16613 end do
16614 end do
16615 end do
16616
16617# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16618#if defined(MFC_OpenACC)
16619# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16620!$acc end parallel loop
16621# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16622#elif defined(MFC_OpenMP)
16623# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16624
16625# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16626!$omp end target teams loop
16627# 3709 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16628#endif
16629 end if
16630 end if
16631 end if
16632 end if
16633
16634 if (bc_x%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
16635
16636
16637# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16638
16639# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16640#if defined(MFC_OpenACC)
16641# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16642!$acc parallel loop collapse(3) gang vector default(present)
16643# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16644#elif defined(MFC_OpenMP)
16645# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16646
16647# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16648
16649# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16650
16651# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16652!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16653# 3717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16654#endif
16655 do i = 1, sys_size
16656 do l = is3%beg, is3%end
16657 do k = is2%beg, is2%end
16658 qr_prim_rsx_vf(m + 1, k, l, i) = ql_prim_rsx_vf(m, k, l, i)
16659 end do
16660 end do
16661 end do
16662
16663# 3725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16664#if defined(MFC_OpenACC)
16665# 3725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16666!$acc end parallel loop
16667# 3725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16668#elif defined(MFC_OpenMP)
16669# 3725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16670
16671# 3725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16672!$omp end target teams loop
16673# 3725 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16674#endif
16675
16676 if (viscous) then
16677
16678# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16679
16680# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16681#if defined(MFC_OpenACC)
16682# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16683!$acc parallel loop collapse(3) gang vector default(present)
16684# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16685#elif defined(MFC_OpenMP)
16686# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16687
16688# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16689
16690# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16691
16692# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16693!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16694# 3728 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16695#endif
16696 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16697 do l = isz%beg, isz%end
16698 do k = isy%beg, isy%end
16699 dqr_prim_dx_vf(i)%sf(m + 1, k, l) = dql_prim_dx_vf(i)%sf(m, k, l)
16700 end do
16701 end do
16702 end do
16703
16704# 3736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16705#if defined(MFC_OpenACC)
16706# 3736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16707!$acc end parallel loop
16708# 3736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16709#elif defined(MFC_OpenMP)
16710# 3736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16711
16712# 3736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16713!$omp end target teams loop
16714# 3736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16715#endif
16716
16717 if (n > 0) then
16718
16719# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16720
16721# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16722#if defined(MFC_OpenACC)
16723# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16724!$acc parallel loop collapse(3) gang vector default(present)
16725# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16726#elif defined(MFC_OpenMP)
16727# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16728
16729# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16730
16731# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16732
16733# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16734!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16735# 3739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16736#endif
16737 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16738 do l = isz%beg, isz%end
16739 do k = isy%beg, isy%end
16740 dqr_prim_dy_vf(i)%sf(m + 1, k, l) = dql_prim_dy_vf(i)%sf(m, k, l)
16741 end do
16742 end do
16743 end do
16744
16745# 3747 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16746#if defined(MFC_OpenACC)
16747# 3747 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16748!$acc end parallel loop
16749# 3747 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16750#elif defined(MFC_OpenMP)
16751# 3747 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16752
16753# 3747 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16754!$omp end target teams loop
16755# 3747 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16756#endif
16757
16758 if (p > 0) then
16759
16760# 3750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16761
16762# 3750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16763#if defined(MFC_OpenACC)
16764# 3750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16765!$acc parallel loop collapse(3) gang vector default(present)
16766# 3750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16767#elif defined(MFC_OpenMP)
16768# 3750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16769
16770# 3750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16771
16772# 3750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16773
16774# 3750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16775!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16776# 3750 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16777#endif
16778 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16779 do l = isz%beg, isz%end
16780 do k = isy%beg, isy%end
16781 dqr_prim_dz_vf(i)%sf(m + 1, k, l) = dql_prim_dz_vf(i)%sf(m, k, l)
16782 end do
16783 end do
16784 end do
16785
16786# 3758 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16787#if defined(MFC_OpenACC)
16788# 3758 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16789!$acc end parallel loop
16790# 3758 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16791#elif defined(MFC_OpenMP)
16792# 3758 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16793
16794# 3758 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16795!$omp end target teams loop
16796# 3758 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16797#endif
16798 end if
16799 end if
16800 end if
16801 end if
16802 ! END: Population of Buffers in x-direction
16803
16804 ! Population of Buffers in y-direction
16805 else if (norm_dir == 2) then
16806 if (bc_y%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
16807
16808# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16809
16810# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16811#if defined(MFC_OpenACC)
16812# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16813!$acc parallel loop collapse(3) gang vector default(present)
16814# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16815#elif defined(MFC_OpenMP)
16816# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16817
16818# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16819
16820# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16821
16822# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16823!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16824# 3768 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16825#endif
16826 do i = 1, sys_size
16827 do l = is3%beg, is3%end
16828 do k = is2%beg, is2%end
16829 ql_prim_rsx_vf(k, -1, l, i) = qr_prim_rsx_vf(k, 0, l, i)
16830 end do
16831 end do
16832 end do
16833
16834# 3776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16835#if defined(MFC_OpenACC)
16836# 3776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16837!$acc end parallel loop
16838# 3776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16839#elif defined(MFC_OpenMP)
16840# 3776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16841
16842# 3776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16843!$omp end target teams loop
16844# 3776 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16845#endif
16846
16847 if (viscous) then
16848
16849# 3779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16850
16851# 3779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16852#if defined(MFC_OpenACC)
16853# 3779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16854!$acc parallel loop collapse(3) gang vector default(present)
16855# 3779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16856#elif defined(MFC_OpenMP)
16857# 3779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16858
16859# 3779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16860
16861# 3779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16862
16863# 3779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16864!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16865# 3779 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16866#endif
16867 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16868 do l = isz%beg, isz%end
16869 do j = isx%beg, isx%end
16870 dql_prim_dx_vf(i)%sf(j, -1, l) = dqr_prim_dx_vf(i)%sf(j, 0, l)
16871 end do
16872 end do
16873 end do
16874
16875# 3787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16876#if defined(MFC_OpenACC)
16877# 3787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16878!$acc end parallel loop
16879# 3787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16880#elif defined(MFC_OpenMP)
16881# 3787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16882
16883# 3787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16884!$omp end target teams loop
16885# 3787 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16886#endif
16887
16888
16889# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16890
16891# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16892#if defined(MFC_OpenACC)
16893# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16894!$acc parallel loop collapse(3) gang vector default(present)
16895# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16896#elif defined(MFC_OpenMP)
16897# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16898
16899# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16900
16901# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16902
16903# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16904!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16905# 3789 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16906#endif
16907 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16908 do l = isz%beg, isz%end
16909 do j = isx%beg, isx%end
16910 dql_prim_dy_vf(i)%sf(j, -1, l) = dqr_prim_dy_vf(i)%sf(j, 0, l)
16911 end do
16912 end do
16913 end do
16914
16915# 3797 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16916#if defined(MFC_OpenACC)
16917# 3797 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16918!$acc end parallel loop
16919# 3797 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16920#elif defined(MFC_OpenMP)
16921# 3797 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16922
16923# 3797 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16924!$omp end target teams loop
16925# 3797 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16926#endif
16927
16928 if (p > 0) then
16929
16930# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16931
16932# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16933#if defined(MFC_OpenACC)
16934# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16935!$acc parallel loop collapse(3) gang vector default(present)
16936# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16937#elif defined(MFC_OpenMP)
16938# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16939
16940# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16941
16942# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16943
16944# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16945!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16946# 3800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16947#endif
16948 do i = eqn_idx%mom%beg, eqn_idx%mom%end
16949 do l = isz%beg, isz%end
16950 do j = isx%beg, isx%end
16951 dql_prim_dz_vf(i)%sf(j, -1, l) = dqr_prim_dz_vf(i)%sf(j, 0, l)
16952 end do
16953 end do
16954 end do
16955
16956# 3808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16957#if defined(MFC_OpenACC)
16958# 3808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16959!$acc end parallel loop
16960# 3808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16961#elif defined(MFC_OpenMP)
16962# 3808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16963
16964# 3808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16965!$omp end target teams loop
16966# 3808 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16967#endif
16968 end if
16969 end if
16970 end if
16971
16972 if (bc_y%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
16973
16974
16975# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16976
16977# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16978#if defined(MFC_OpenACC)
16979# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16980!$acc parallel loop collapse(3) gang vector default(present)
16981# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16982#elif defined(MFC_OpenMP)
16983# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16984
16985# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16986
16987# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16988
16989# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16990!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
16991# 3815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16992#endif
16993 do i = 1, sys_size
16994 do l = is3%beg, is3%end
16995 do k = is2%beg, is2%end
16996 qr_prim_rsx_vf(k, n + 1, l, i) = ql_prim_rsx_vf(k, n, l, i)
16997 end do
16998 end do
16999 end do
17000
17001# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17002#if defined(MFC_OpenACC)
17003# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17004!$acc end parallel loop
17005# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17006#elif defined(MFC_OpenMP)
17007# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17008
17009# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17010!$omp end target teams loop
17011# 3823 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17012#endif
17013
17014 if (viscous) then
17015
17016# 3826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17017
17018# 3826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17019#if defined(MFC_OpenACC)
17020# 3826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17021!$acc parallel loop collapse(3) gang vector default(present)
17022# 3826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17023#elif defined(MFC_OpenMP)
17024# 3826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17025
17026# 3826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17027
17028# 3826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17029
17030# 3826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17031!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17032# 3826 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17033#endif
17034 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17035 do l = isz%beg, isz%end
17036 do j = isx%beg, isx%end
17037 dqr_prim_dx_vf(i)%sf(j, n + 1, l) = dql_prim_dx_vf(i)%sf(j, n, l)
17038 end do
17039 end do
17040 end do
17041
17042# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17043#if defined(MFC_OpenACC)
17044# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17045!$acc end parallel loop
17046# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17047#elif defined(MFC_OpenMP)
17048# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17049
17050# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17051!$omp end target teams loop
17052# 3834 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17053#endif
17054
17055
17056# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17057
17058# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17059#if defined(MFC_OpenACC)
17060# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17061!$acc parallel loop collapse(3) gang vector default(present)
17062# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17063#elif defined(MFC_OpenMP)
17064# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17065
17066# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17067
17068# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17069
17070# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17071!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17072# 3836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17073#endif
17074 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17075 do l = isz%beg, isz%end
17076 do j = isx%beg, isx%end
17077 dqr_prim_dy_vf(i)%sf(j, n + 1, l) = dql_prim_dy_vf(i)%sf(j, n, l)
17078 end do
17079 end do
17080 end do
17081
17082# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17083#if defined(MFC_OpenACC)
17084# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17085!$acc end parallel loop
17086# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17087#elif defined(MFC_OpenMP)
17088# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17089
17090# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17091!$omp end target teams loop
17092# 3844 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17093#endif
17094
17095 if (p > 0) then
17096
17097# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17098
17099# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17100#if defined(MFC_OpenACC)
17101# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17102!$acc parallel loop collapse(3) gang vector default(present)
17103# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17104#elif defined(MFC_OpenMP)
17105# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17106
17107# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17108
17109# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17110
17111# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17112!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17113# 3847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17114#endif
17115 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17116 do l = isz%beg, isz%end
17117 do j = isx%beg, isx%end
17118 dqr_prim_dz_vf(i)%sf(j, n + 1, l) = dql_prim_dz_vf(i)%sf(j, n, l)
17119 end do
17120 end do
17121 end do
17122
17123# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17124#if defined(MFC_OpenACC)
17125# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17126!$acc end parallel loop
17127# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17128#elif defined(MFC_OpenMP)
17129# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17130
17131# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17132!$omp end target teams loop
17133# 3855 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17134#endif
17135 end if
17136 end if
17137 end if
17138 ! END: Population of Buffers in y-direction
17139
17140 ! Population of Buffers in z-direction
17141 else
17142 if (bc_z%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
17143
17144# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17145
17146# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17147#if defined(MFC_OpenACC)
17148# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17149!$acc parallel loop collapse(3) gang vector default(present)
17150# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17151#elif defined(MFC_OpenMP)
17152# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17153
17154# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17155
17156# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17157
17158# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17159!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17160# 3864 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17161#endif
17162 do i = 1, sys_size
17163 do k = is2%beg, is2%end
17164 do l = is3%beg, is3%end
17165 ql_prim_rsx_vf(l, k, -1, i) = qr_prim_rsx_vf(l, k, 0, i)
17166 end do
17167 end do
17168 end do
17169
17170# 3872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17171#if defined(MFC_OpenACC)
17172# 3872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17173!$acc end parallel loop
17174# 3872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17175#elif defined(MFC_OpenMP)
17176# 3872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17177
17178# 3872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17179!$omp end target teams loop
17180# 3872 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17181#endif
17182
17183 if (viscous) then
17184
17185# 3875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17186
17187# 3875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17188#if defined(MFC_OpenACC)
17189# 3875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17190!$acc parallel loop collapse(3) gang vector default(present)
17191# 3875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17192#elif defined(MFC_OpenMP)
17193# 3875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17194
17195# 3875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17196
17197# 3875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17198
17199# 3875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17200!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17201# 3875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17202#endif
17203 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17204 do k = isy%beg, isy%end
17205 do j = isx%beg, isx%end
17206 dql_prim_dx_vf(i)%sf(j, k, -1) = dqr_prim_dx_vf(i)%sf(j, k, 0)
17207 end do
17208 end do
17209 end do
17210
17211# 3883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17212#if defined(MFC_OpenACC)
17213# 3883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17214!$acc end parallel loop
17215# 3883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17216#elif defined(MFC_OpenMP)
17217# 3883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17218
17219# 3883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17220!$omp end target teams loop
17221# 3883 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17222#endif
17223
17224# 3884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17225
17226# 3884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17227#if defined(MFC_OpenACC)
17228# 3884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17229!$acc parallel loop collapse(3) gang vector default(present)
17230# 3884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17231#elif defined(MFC_OpenMP)
17232# 3884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17233
17234# 3884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17235
17236# 3884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17237
17238# 3884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17239!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17240# 3884 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17241#endif
17242 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17243 do k = isy%beg, isy%end
17244 do j = isx%beg, isx%end
17245 dql_prim_dy_vf(i)%sf(j, k, -1) = dqr_prim_dy_vf(i)%sf(j, k, 0)
17246 end do
17247 end do
17248 end do
17249
17250# 3892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17251#if defined(MFC_OpenACC)
17252# 3892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17253!$acc end parallel loop
17254# 3892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17255#elif defined(MFC_OpenMP)
17256# 3892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17257
17258# 3892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17259!$omp end target teams loop
17260# 3892 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17261#endif
17262
17263# 3893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17264
17265# 3893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17266#if defined(MFC_OpenACC)
17267# 3893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17268!$acc parallel loop collapse(3) gang vector default(present)
17269# 3893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17270#elif defined(MFC_OpenMP)
17271# 3893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17272
17273# 3893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17274
17275# 3893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17276
17277# 3893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17278!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17279# 3893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17280#endif
17281 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17282 do k = isy%beg, isy%end
17283 do j = isx%beg, isx%end
17284 dql_prim_dz_vf(i)%sf(j, k, -1) = dqr_prim_dz_vf(i)%sf(j, k, 0)
17285 end do
17286 end do
17287 end do
17288
17289# 3901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17290#if defined(MFC_OpenACC)
17291# 3901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17292!$acc end parallel loop
17293# 3901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17294#elif defined(MFC_OpenMP)
17295# 3901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17296
17297# 3901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17298!$omp end target teams loop
17299# 3901 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17300#endif
17301 end if
17302 end if
17303
17304 if (bc_z%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
17305
17306
17307# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17308
17309# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17310#if defined(MFC_OpenACC)
17311# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17312!$acc parallel loop collapse(3) gang vector default(present)
17313# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17314#elif defined(MFC_OpenMP)
17315# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17316
17317# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17318
17319# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17320
17321# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17322!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17323# 3907 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17324#endif
17325 do i = 1, sys_size
17326 do k = is2%beg, is2%end
17327 do l = is3%beg, is3%end
17328 qr_prim_rsx_vf(l, k, p + 1, i) = ql_prim_rsx_vf(l, k, p, i)
17329 end do
17330 end do
17331 end do
17332
17333# 3915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17334#if defined(MFC_OpenACC)
17335# 3915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17336!$acc end parallel loop
17337# 3915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17338#elif defined(MFC_OpenMP)
17339# 3915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17340
17341# 3915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17342!$omp end target teams loop
17343# 3915 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17344#endif
17345
17346 if (viscous) then
17347
17348# 3918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17349
17350# 3918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17351#if defined(MFC_OpenACC)
17352# 3918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17353!$acc parallel loop collapse(3) gang vector default(present)
17354# 3918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17355#elif defined(MFC_OpenMP)
17356# 3918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17357
17358# 3918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17359
17360# 3918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17361
17362# 3918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17363!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17364# 3918 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17365#endif
17366 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17367 do k = isy%beg, isy%end
17368 do j = isx%beg, isx%end
17369 dqr_prim_dx_vf(i)%sf(j, k, p + 1) = dql_prim_dx_vf(i)%sf(j, k, p)
17370 end do
17371 end do
17372 end do
17373
17374# 3926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17375#if defined(MFC_OpenACC)
17376# 3926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17377!$acc end parallel loop
17378# 3926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17379#elif defined(MFC_OpenMP)
17380# 3926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17381
17382# 3926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17383!$omp end target teams loop
17384# 3926 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17385#endif
17386
17387
17388# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17389
17390# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17391#if defined(MFC_OpenACC)
17392# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17393!$acc parallel loop collapse(3) gang vector default(present)
17394# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17395#elif defined(MFC_OpenMP)
17396# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17397
17398# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17399
17400# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17401
17402# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17403!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17404# 3928 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17405#endif
17406 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17407 do k = isy%beg, isy%end
17408 do j = isx%beg, isx%end
17409 dqr_prim_dy_vf(i)%sf(j, k, p + 1) = dql_prim_dy_vf(i)%sf(j, k, p)
17410 end do
17411 end do
17412 end do
17413
17414# 3936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17415#if defined(MFC_OpenACC)
17416# 3936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17417!$acc end parallel loop
17418# 3936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17419#elif defined(MFC_OpenMP)
17420# 3936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17421
17422# 3936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17423!$omp end target teams loop
17424# 3936 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17425#endif
17426
17427
17428# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17429
17430# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17431#if defined(MFC_OpenACC)
17432# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17433!$acc parallel loop collapse(3) gang vector default(present)
17434# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17435#elif defined(MFC_OpenMP)
17436# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17437
17438# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17439
17440# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17441
17442# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17443!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17444# 3938 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17445#endif
17446 do i = eqn_idx%mom%beg, eqn_idx%mom%end
17447 do k = isy%beg, isy%end
17448 do j = isx%beg, isx%end
17449 dqr_prim_dz_vf(i)%sf(j, k, p + 1) = dql_prim_dz_vf(i)%sf(j, k, p)
17450 end do
17451 end do
17452 end do
17453
17454# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17455#if defined(MFC_OpenACC)
17456# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17457!$acc end parallel loop
17458# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17459#elif defined(MFC_OpenMP)
17460# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17461
17462# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17463!$omp end target teams loop
17464# 3946 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17465#endif
17466 end if
17467 end if
17468 end if
17469 ! END: Population of Buffers in z-direction
17470
17471 end subroutine s_populate_riemann_states_variables_buffers
17472
17473 !> Set up the chosen Riemann solver algorithm for the current direction
17474 subroutine s_initialize_riemann_solver(flux_src_vf, norm_dir)
17475
17476 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
17477 integer, intent(in) :: norm_dir
17478 integer :: i, j, k, l !< Generic loop iterators
17479
17480 ! Reshaping Inputted Data in x-direction
17481
17482 if (norm_dir == 1) then
17483 if (viscous .or. (surface_tension)) then
17484
17485# 3965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17486
17487# 3965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17488#if defined(MFC_OpenACC)
17489# 3965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17490!$acc parallel loop collapse(4) gang vector default(present)
17491# 3965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17492#elif defined(MFC_OpenMP)
17493# 3965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17494
17495# 3965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17496
17497# 3965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17498
17499# 3965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17500!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17501# 3965 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17502#endif
17503 do i = eqn_idx%mom%beg, eqn_idx%E
17504 do l = is3%beg, is3%end
17505 do k = is2%beg, is2%end
17506 do j = is1%beg, is1%end
17507 flux_src_vf(i)%sf(j, k, l) = 0._wp
17508 end do
17509 end do
17510 end do
17511 end do
17512
17513# 3975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17514#if defined(MFC_OpenACC)
17515# 3975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17516!$acc end parallel loop
17517# 3975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17518#elif defined(MFC_OpenMP)
17519# 3975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17520
17521# 3975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17522!$omp end target teams loop
17523# 3975 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17524#endif
17525 end if
17526
17527 if (chem_params%diffusion) then
17528
17529# 3979 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17530
17531# 3979 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17532#if defined(MFC_OpenACC)
17533# 3979 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17534!$acc parallel loop collapse(4) gang vector default(present)
17535# 3979 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17536#elif defined(MFC_OpenMP)
17537# 3979 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17538
17539# 3979 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17540
17541# 3979 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17542
17543# 3979 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17544!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17545# 3979 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17546#endif
17547 do i = eqn_idx%E, eqn_idx%species%end
17548 do l = is3%beg, is3%end
17549 do k = is2%beg, is2%end
17550 do j = is1%beg, is1%end
17551 if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then
17552 flux_src_vf(i)%sf(j, k, l) = 0._wp
17553 end if
17554 end do
17555 end do
17556 end do
17557 end do
17558
17559# 3991 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17560#if defined(MFC_OpenACC)
17561# 3991 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17562!$acc end parallel loop
17563# 3991 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17564#elif defined(MFC_OpenMP)
17565# 3991 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17566
17567# 3991 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17568!$omp end target teams loop
17569# 3991 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17570#endif
17571 end if
17572
17573 if (qbmm) then
17574
17575# 3995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17576
17577# 3995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17578#if defined(MFC_OpenACC)
17579# 3995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17580!$acc parallel loop collapse(4) gang vector default(present)
17581# 3995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17582#elif defined(MFC_OpenMP)
17583# 3995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17584
17585# 3995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17586
17587# 3995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17588
17589# 3995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17590!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17591# 3995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17592#endif
17593 do i = 1, 4
17594 do l = is3%beg, is3%end
17595 do k = is2%beg, is2%end
17596 do j = is1%beg, is1%end + 1
17597 mom_sp_rsx_vf(j, k, l, i) = mom_sp(i)%sf(j, k, l)
17598 end do
17599 end do
17600 end do
17601 end do
17602
17603# 4005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17604#if defined(MFC_OpenACC)
17605# 4005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17606!$acc end parallel loop
17607# 4005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17608#elif defined(MFC_OpenMP)
17609# 4005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17610
17611# 4005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17612!$omp end target teams loop
17613# 4005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17614#endif
17615 end if
17616
17617 ! Reshaping Inputted Data in y-direction
17618 else if (norm_dir == 2) then
17619 if (viscous .or. (surface_tension)) then
17620
17621# 4011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17622
17623# 4011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17624#if defined(MFC_OpenACC)
17625# 4011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17626!$acc parallel loop collapse(4) gang vector default(present)
17627# 4011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17628#elif defined(MFC_OpenMP)
17629# 4011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17630
17631# 4011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17632
17633# 4011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17634
17635# 4011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17636!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17637# 4011 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17638#endif
17639 do i = eqn_idx%mom%beg, eqn_idx%E
17640 do l = is3%beg, is3%end
17641 do j = is1%beg, is1%end
17642 do k = is2%beg, is2%end
17643 flux_src_vf(i)%sf(k, j, l) = 0._wp
17644 end do
17645 end do
17646 end do
17647 end do
17648
17649# 4021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17650#if defined(MFC_OpenACC)
17651# 4021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17652!$acc end parallel loop
17653# 4021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17654#elif defined(MFC_OpenMP)
17655# 4021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17656
17657# 4021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17658!$omp end target teams loop
17659# 4021 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17660#endif
17661 end if
17662
17663 if (chem_params%diffusion) then
17664
17665# 4025 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17666
17667# 4025 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17668#if defined(MFC_OpenACC)
17669# 4025 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17670!$acc parallel loop collapse(4) gang vector default(present)
17671# 4025 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17672#elif defined(MFC_OpenMP)
17673# 4025 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17674
17675# 4025 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17676
17677# 4025 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17678
17679# 4025 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17680!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17681# 4025 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17682#endif
17683 do i = eqn_idx%E, eqn_idx%species%end
17684 do l = is3%beg, is3%end
17685 do j = is1%beg, is1%end
17686 do k = is2%beg, is2%end
17687 if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then
17688 flux_src_vf(i)%sf(k, j, l) = 0._wp
17689 end if
17690 end do
17691 end do
17692 end do
17693 end do
17694
17695# 4037 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17696#if defined(MFC_OpenACC)
17697# 4037 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17698!$acc end parallel loop
17699# 4037 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17700#elif defined(MFC_OpenMP)
17701# 4037 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17702
17703# 4037 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17704!$omp end target teams loop
17705# 4037 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17706#endif
17707 end if
17708
17709 if (qbmm) then
17710
17711# 4041 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17712
17713# 4041 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17714#if defined(MFC_OpenACC)
17715# 4041 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17716!$acc parallel loop collapse(4) gang vector default(present)
17717# 4041 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17718#elif defined(MFC_OpenMP)
17719# 4041 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17720
17721# 4041 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17722
17723# 4041 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17724
17725# 4041 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17726!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17727# 4041 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17728#endif
17729 do i = 1, 4
17730 do l = is3%beg, is3%end
17731 do k = is2%beg, is2%end
17732 do j = is1%beg, is1%end + 1
17733 mom_sp_rsx_vf(k, j, l, i) = mom_sp(i)%sf(k, j, l)
17734 end do
17735 end do
17736 end do
17737 end do
17738
17739# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17740#if defined(MFC_OpenACC)
17741# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17742!$acc end parallel loop
17743# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17744#elif defined(MFC_OpenMP)
17745# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17746
17747# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17748!$omp end target teams loop
17749# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17750#endif
17751 end if
17752
17753 ! Reshaping Inputted Data in z-direction
17754 else
17755 if (viscous .or. (surface_tension)) then
17756
17757# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17758
17759# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17760#if defined(MFC_OpenACC)
17761# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17762!$acc parallel loop collapse(4) gang vector default(present)
17763# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17764#elif defined(MFC_OpenMP)
17765# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17766
17767# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17768
17769# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17770
17771# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17772!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17773# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17774#endif
17775 do i = eqn_idx%mom%beg, eqn_idx%E
17776 do j = is1%beg, is1%end
17777 do k = is2%beg, is2%end
17778 do l = is3%beg, is3%end
17779 flux_src_vf(i)%sf(l, k, j) = 0._wp
17780 end do
17781 end do
17782 end do
17783 end do
17784
17785# 4067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17786#if defined(MFC_OpenACC)
17787# 4067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17788!$acc end parallel loop
17789# 4067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17790#elif defined(MFC_OpenMP)
17791# 4067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17792
17793# 4067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17794!$omp end target teams loop
17795# 4067 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17796#endif
17797 end if
17798
17799 if (chem_params%diffusion) then
17800
17801# 4071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17802
17803# 4071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17804#if defined(MFC_OpenACC)
17805# 4071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17806!$acc parallel loop collapse(4) gang vector default(present)
17807# 4071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17808#elif defined(MFC_OpenMP)
17809# 4071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17810
17811# 4071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17812
17813# 4071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17814
17815# 4071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17816!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17817# 4071 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17818#endif
17819 do i = eqn_idx%E, eqn_idx%species%end
17820 do j = is1%beg, is1%end
17821 do k = is2%beg, is2%end
17822 do l = is3%beg, is3%end
17823 if (i == eqn_idx%E .or. i >= eqn_idx%species%beg) then
17824 flux_src_vf(i)%sf(l, k, j) = 0._wp
17825 end if
17826 end do
17827 end do
17828 end do
17829 end do
17830
17831# 4083 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17832#if defined(MFC_OpenACC)
17833# 4083 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17834!$acc end parallel loop
17835# 4083 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17836#elif defined(MFC_OpenMP)
17837# 4083 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17838
17839# 4083 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17840!$omp end target teams loop
17841# 4083 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17842#endif
17843 end if
17844
17845 if (qbmm) then
17846
17847# 4087 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17848
17849# 4087 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17850#if defined(MFC_OpenACC)
17851# 4087 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17852!$acc parallel loop collapse(4) gang vector default(present)
17853# 4087 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17854#elif defined(MFC_OpenMP)
17855# 4087 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17856
17857# 4087 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17858
17859# 4087 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17860
17861# 4087 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17862!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
17863# 4087 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17864#endif
17865 do i = 1, 4
17866 do l = is3%beg, is3%end
17867 do k = is2%beg, is2%end
17868 do j = is1%beg, is1%end + 1
17869 mom_sp_rsx_vf(l, k, j, i) = mom_sp(i)%sf(l, k, j)
17870 end do
17871 end do
17872 end do
17873 end do
17874
17875# 4097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17876#if defined(MFC_OpenACC)
17877# 4097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17878!$acc end parallel loop
17879# 4097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17880#elif defined(MFC_OpenMP)
17881# 4097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17882
17883# 4097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17884!$omp end target teams loop
17885# 4097 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17886#endif
17887 end if
17888 end if
17889
17890 end subroutine s_initialize_riemann_solver
17891
17892 !> Compute cylindrical viscous source flux contributions for momentum and energy
17893 subroutine s_compute_cylindrical_viscous_source_flux(velL_vf, dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, velR_vf, dvelR_dx_vf, &
17894
17895 & dvelR_dy_vf, dvelR_dz_vf, flux_src_vf, norm_dir, ix, iy, iz)
17896
17897 type(scalar_field), dimension(num_dims), intent(in) :: velL_vf, velR_vf
17898 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
17899 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
17900 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
17901 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
17902 integer, intent(in) :: norm_dir
17903 type(int_bounds_info), intent(in) :: ix, iy, iz
17904
17905 ! Local variables
17906
17907# 4128 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17908 real(wp), dimension(num_dims) :: avg_v_int !< Averaged interface velocity (\f$v_x, v_y, v_z\f$) (grid directions).
17909 real(wp), dimension(num_dims) :: avg_dvdx_int !< Averaged interface \f$\partial v_i/\partial x\f$ (grid dir 1).
17910 real(wp), dimension(num_dims) :: avg_dvdy_int !< Averaged interface \f$\partial v_i/\partial y\f$ (grid dir 2).
17911 real(wp), dimension(num_dims) :: avg_dvdz_int !< Averaged interface \f$\partial v_i/\partial z\f$ (grid dir 3).
17912 !> Interface velocity (\f$v_1,v_2,v_3\f$) (grid directions) for viscous work.
17913 real(wp), dimension(num_dims) :: vel_src_int
17914 !> Shear stress vector (\f$\sigma_{N1}, \sigma_{N2}, \sigma_{N3}\f$) on N-face (grid directions).
17915 real(wp), dimension(num_dims) :: stress_vector_shear
17916# 4137 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17917 real(wp) :: stress_normal_bulk !< Normal bulk stress component \f$\sigma_{NN}\f$ on N-face.
17918 real(wp) :: Re_s, Re_b !< Effective interface shear and bulk Reynolds numbers.
17919 real(wp) :: r_eff !< Effective radius at interface for cylindrical terms.
17920 real(wp) :: div_v_term_const !< Common term \f$-(2/3)(\nabla \cdot \mathbf{v}) / \text{Re}_s\f$ for shear stress diagonal.
17921 real(wp) :: divergence_cyl !< Full divergence \f$\nabla \cdot \mathbf{v}\f$ in cylindrical coordinates.
17922 integer :: j, k, l !< Loop iterators for \f$x, y, z\f$ grid directions.
17923 integer :: i_vel !< Loop iterator for velocity components.
17924 integer :: idx_rp(3) !< Indices \f$(j,k,l)\f$ of 'right' point for averaging.
17925
17926
17927# 4146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17928
17929# 4146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17930#if defined(MFC_OpenACC)
17931# 4146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17932!$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)
17933# 4146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17934#elif defined(MFC_OpenMP)
17935# 4146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17936
17937# 4146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17938
17939# 4146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17940
17941# 4146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17942!$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)
17943# 4146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17944#endif
17945# 4148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17946 do l = iz%beg, iz%end
17947 do k = iy%beg, iy%end
17948 do j = ix%beg, ix%end
17949 ! Determine indices for the 'right' state for averaging across the interface
17950 idx_rp = [j, k, l]
17951 idx_rp(norm_dir) = idx_rp(norm_dir) + 1
17952
17953 ! Average velocities and their derivatives at the interface For cylindrical: x-dir ~ axial (z_cyl), y-dir ~
17954 ! radial (r_cyl), z-dir ~ azimuthal (theta_cyl)
17955
17956# 4157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17957#if defined(MFC_OpenACC)
17958# 4157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17959!$acc loop seq
17960# 4157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17961#elif defined(MFC_OpenMP)
17962# 4157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17963
17964# 4157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17965#endif
17966 do i_vel = 1, num_dims
17967 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)))
17968
17969 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), &
17970 & idx_rp(2), idx_rp(3)))
17971 if (num_dims > 1) then
17972 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), &
17973 & idx_rp(2), idx_rp(3)))
17974 else
17975 avg_dvdy_int(i_vel) = 0.0_wp
17976 end if
17977 if (num_dims > 2) then
17978 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), &
17979 & idx_rp(2), idx_rp(3)))
17980 else
17981 avg_dvdz_int(i_vel) = 0.0_wp
17982 end if
17983 end do
17984
17985 ! Get Re numbers and interface velocity for viscous work
17986 select case (norm_dir)
17987 case (1) ! x-face (axial face in z_cyl direction)
17988 re_s = re_avg_rsx_vf(j, k, l, 1)
17989 re_b = re_avg_rsx_vf(j, k, l, 2)
17990 vel_src_int = vel_src_rsx_vf(j, k, l,1:num_dims)
17991 r_eff = y_cc(k)
17992 case (2) ! y-face (radial face in r_cyl direction)
17993 re_s = re_avg_rsx_vf(j, k, l, 1)
17994 re_b = re_avg_rsx_vf(j, k, l, 2)
17995 vel_src_int = vel_src_rsx_vf(j, k, l,1:num_dims)
17996 r_eff = y_cb(k)
17997 case (3) ! z-face (azimuthal face in theta_cyl direction)
17998 re_s = re_avg_rsx_vf(j, k, l, 1)
17999 re_b = re_avg_rsx_vf(j, k, l, 2)
18000 vel_src_int = vel_src_rsx_vf(j, k, l,1:num_dims)
18001 r_eff = y_cc(k)
18002 end select
18003
18004 ! Divergence in cylindrical coordinates (vx=vz_cyl, vy=vr_cyl, vz=vtheta_cyl)
18005# 4198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18006 divergence_cyl = avg_dvdx_int(1) + avg_dvdy_int(2) + avg_v_int(2)/r_eff
18007 if (num_dims > 2) then
18008# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18009 divergence_cyl = divergence_cyl + avg_dvdz_int(3)/r_eff
18010# 4203 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18011 end if
18012# 4205 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18013
18014 stress_vector_shear = 0.0_wp
18015 stress_normal_bulk = 0.0_wp
18016
18017 if (shear_stress) then
18018 div_v_term_const = -(2.0_wp/3.0_wp)*divergence_cyl/re_s
18019
18020 select case (norm_dir)
18021 case (1) ! X-face (axial normal, z_cyl)
18022 stress_vector_shear(1) = (2.0_wp*avg_dvdx_int(1))/re_s + div_v_term_const
18023 if (num_dims > 1) then
18024# 4217 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18025 stress_vector_shear(2) = (avg_dvdy_int(1) + avg_dvdx_int(2))/re_s
18026# 4219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18027 end if
18028 if (num_dims > 2) then
18029# 4222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18030 stress_vector_shear(3) = (avg_dvdz_int(1)/r_eff + avg_dvdx_int(3))/re_s
18031# 4224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18032 end if
18033 case (2) ! Y-face (radial normal, r_cyl)
18034 if (num_dims > 1) then
18035# 4228 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18036 stress_vector_shear(1) = (avg_dvdy_int(1) + avg_dvdx_int(2))/re_s
18037 stress_vector_shear(2) = (2.0_wp*avg_dvdy_int(2))/re_s + div_v_term_const
18038 if (num_dims > 2) then
18039# 4232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18040 stress_vector_shear(3) = (avg_dvdz_int(2)/r_eff - avg_v_int(3)/r_eff + avg_dvdy_int(3) &
18041 & )/re_s
18042# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18043 end if
18044# 4237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18045 else
18046 stress_vector_shear(1) = (2.0_wp*avg_dvdx_int(1))/re_s + div_v_term_const
18047 end if
18048 case (3) ! Z-face (azimuthal normal, theta_cyl)
18049 if (num_dims > 2) then
18050# 4243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18051 stress_vector_shear(1) = (avg_dvdz_int(1)/r_eff + avg_dvdx_int(3))/re_s
18052 stress_vector_shear(2) = (avg_dvdz_int(2)/r_eff - avg_v_int(3)/r_eff + avg_dvdy_int(3))/re_s
18053 stress_vector_shear(3) = (2.0_wp*(avg_dvdz_int(3)/r_eff + avg_v_int(2)/r_eff))/re_s &
18054 & + div_v_term_const
18055# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18056 end if
18057 end select
18058
18059
18060# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18061#if defined(MFC_OpenACC)
18062# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18063!$acc loop seq
18064# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18065#elif defined(MFC_OpenMP)
18066# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18067
18068# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18069#endif
18070 do i_vel = 1, num_dims
18071 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, &
18072 & k, l) - stress_vector_shear(i_vel)
18073 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
18074 & l) - vel_src_int(i_vel)*stress_vector_shear(i_vel)
18075 end do
18076 end if
18077
18078 if (bulk_stress) then
18079 stress_normal_bulk = divergence_cyl/re_b
18080
18081 flux_src_vf(eqn_idx%mom%beg + norm_dir - 1)%sf(j, k, &
18082 & l) = flux_src_vf(eqn_idx%mom%beg + norm_dir - 1)%sf(j, k, l) - stress_normal_bulk
18083 flux_src_vf(eqn_idx%E)%sf(j, k, l) = flux_src_vf(eqn_idx%E)%sf(j, k, &
18084 & l) - vel_src_int(norm_dir)*stress_normal_bulk
18085 end if
18086 end do
18087 end do
18088 end do
18089
18090# 4271 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18091#if defined(MFC_OpenACC)
18092# 4271 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18093!$acc end parallel loop
18094# 4271 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18095#elif defined(MFC_OpenMP)
18096# 4271 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18097
18098# 4271 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18099!$omp end target teams loop
18100# 4271 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18101#endif
18102
18103 end subroutine s_compute_cylindrical_viscous_source_flux
18104
18105 !> Compute Cartesian viscous source flux contributions for momentum and energy
18106 subroutine s_compute_cartesian_viscous_source_flux(dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, dvelR_dx_vf, dvelR_dy_vf, &
18107
18108 & dvelR_dz_vf, flux_src_vf, norm_dir)
18109
18110 ! Arguments
18111 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
18112 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
18113 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
18114 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
18115 integer, intent(in) :: norm_dir
18116
18117 ! Local variables
18118
18119# 4295 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18120 real(wp), dimension(num_dims, num_dims) :: vel_grad_avg !< Averaged velocity gradient tensor `d(vel_i)/d(coord_j)`.
18121 real(wp), dimension(num_dims, num_dims) :: current_tau_shear !< Current shear stress tensor.
18122 real(wp), dimension(num_dims, num_dims) :: current_tau_bulk !< Current bulk stress tensor.
18123 real(wp), dimension(num_dims) :: vel_src_at_interface !< Interface velocities (u,v,w) for viscous work.
18124# 4300 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18125 integer, dimension(3) :: idx_right_phys !< Physical (j,k,l) indices for right state.
18126 real(wp) :: Re_shear !< Interface shear Reynolds number.
18127 real(wp) :: Re_bulk !< Interface bulk Reynolds number.
18128 integer :: j_loop !< Physical x-index loop iterator.
18129 integer :: k_loop !< Physical y-index loop iterator.
18130 integer :: l_loop !< Physical z-index loop iterator.
18131 integer :: i_dim !< Generic dimension/component iterator.
18132 integer :: vel_comp_idx !< Velocity component iterator (1=u, 2=v, 3=w).
18133 real(wp) :: divergence_v !< Velocity divergence at interface.
18134
18135
18136# 4310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18137
18138# 4310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18139#if defined(MFC_OpenACC)
18140# 4310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18141!$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)
18142# 4310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18143#elif defined(MFC_OpenMP)
18144# 4310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18145
18146# 4310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18147
18148# 4310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18149
18150# 4310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18151!$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)
18152# 4310 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18153#endif
18154# 4312 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18155 do l_loop = isz%beg, isz%end
18156 do k_loop = isy%beg, isy%end
18157 do j_loop = isx%beg, isx%end
18158 idx_right_phys(1) = j_loop
18159 idx_right_phys(2) = k_loop
18160 idx_right_phys(3) = l_loop
18161 idx_right_phys(norm_dir) = idx_right_phys(norm_dir) + 1
18162
18163 vel_grad_avg = 0.0_wp
18164 do vel_comp_idx = 1, num_dims
18165 vel_grad_avg(vel_comp_idx, 1) = 0.5_wp*(dvell_dx_vf(vel_comp_idx)%sf(j_loop, k_loop, &
18166 & l_loop) + dvelr_dx_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), &
18167 & idx_right_phys(3)))
18168 if (num_dims > 1) then
18169# 4327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18170 vel_grad_avg(vel_comp_idx, 2) = 0.5_wp*(dvell_dy_vf(vel_comp_idx)%sf(j_loop, k_loop, &
18171 & l_loop) + dvelr_dy_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), &
18172 & idx_right_phys(3)))
18173# 4331 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18174 end if
18175 if (num_dims > 2) then
18176# 4334 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18177 vel_grad_avg(vel_comp_idx, 3) = 0.5_wp*(dvell_dz_vf(vel_comp_idx)%sf(j_loop, k_loop, &
18178 & l_loop) + dvelr_dz_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), &
18179 & idx_right_phys(3)))
18180# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18181 end if
18182 end do
18183
18184 divergence_v = 0.0_wp
18185 do i_dim = 1, num_dims
18186 divergence_v = divergence_v + vel_grad_avg(i_dim, i_dim)
18187 end do
18188
18189 vel_src_at_interface = 0.0_wp
18190 if (norm_dir == 1) then
18191 re_shear = re_avg_rsx_vf(j_loop, k_loop, l_loop, 1)
18192 re_bulk = re_avg_rsx_vf(j_loop, k_loop, l_loop, 2)
18193 do i_dim = 1, num_dims
18194 vel_src_at_interface(i_dim) = vel_src_rsx_vf(j_loop, k_loop, l_loop, i_dim)
18195 end do
18196 else if (norm_dir == 2) then
18197 re_shear = re_avg_rsx_vf(j_loop, k_loop, l_loop, 1)
18198 re_bulk = re_avg_rsx_vf(j_loop, k_loop, l_loop, 2)
18199 do i_dim = 1, num_dims
18200 vel_src_at_interface(i_dim) = vel_src_rsx_vf(j_loop, k_loop, l_loop, i_dim)
18201 end do
18202 else
18203 re_shear = re_avg_rsx_vf(j_loop, k_loop, l_loop, 1)
18204 re_bulk = re_avg_rsx_vf(j_loop, k_loop, l_loop, 2)
18205 do i_dim = 1, num_dims
18206 vel_src_at_interface(i_dim) = vel_src_rsx_vf(j_loop, k_loop, l_loop, i_dim)
18207 end do
18208 end if
18209
18210 if (shear_stress) then
18211 ! current_tau_shear = 0.0_wp
18212 call s_calculate_shear_stress_tensor(vel_grad_avg, re_shear, divergence_v, current_tau_shear)
18213
18214 do i_dim = 1, num_dims
18215 flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
18216 & l_loop) = flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
18217 & l_loop) - current_tau_shear(norm_dir, i_dim)
18218
18219 flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, &
18220 & l_loop) - vel_src_at_interface(i_dim)*current_tau_shear(norm_dir, i_dim)
18221 end do
18222 end if
18223
18224 if (bulk_stress) then
18225 ! current_tau_bulk = 0.0_wp
18226 call s_calculate_bulk_stress_tensor(re_bulk, divergence_v, current_tau_bulk)
18227
18228 do i_dim = 1, num_dims
18229 flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
18230 & l_loop) = flux_src_vf(eqn_idx%mom%beg + i_dim - 1)%sf(j_loop, k_loop, &
18231 & l_loop) - current_tau_bulk(norm_dir, i_dim)
18232
18233 flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, l_loop) = flux_src_vf(eqn_idx%E)%sf(j_loop, k_loop, &
18234 & l_loop) - vel_src_at_interface(i_dim)*current_tau_bulk(norm_dir, i_dim)
18235 end do
18236 end if
18237 end do
18238 end do
18239 end do
18240
18241# 4397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18242#if defined(MFC_OpenACC)
18243# 4397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18244!$acc end parallel loop
18245# 4397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18246#elif defined(MFC_OpenMP)
18247# 4397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18248
18249# 4397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18250!$omp end target teams loop
18251# 4397 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18252#endif
18253
18254 end subroutine s_compute_cartesian_viscous_source_flux
18255
18256 !> Compute shear stress tensor components
18257 subroutine s_calculate_shear_stress_tensor(vel_grad_avg, Re_shear, divergence_v, tau_shear_out)
18258
18259
18260# 4404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18261#if MFC_OpenACC
18262# 4404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18263!$acc routine seq
18264# 4404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18265#elif MFC_OpenMP
18266# 4404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18267
18268# 4404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18269
18270# 4404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18271!$omp declare target device_type(any)
18272# 4404 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18273#endif
18274
18275 ! Arguments
18276# 4411 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18277 real(wp), dimension(num_dims, num_dims), intent(in) :: vel_grad_avg
18278 real(wp), dimension(num_dims, num_dims), intent(out) :: tau_shear_out
18279# 4414 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18280 real(wp), intent(in) :: Re_shear
18281 real(wp), intent(in) :: divergence_v
18282
18283 ! Local variables
18284 integer :: i_dim !< Loop iterator for face normal.
18285 integer :: j_dim !< Loop iterator for force component direction.
18286 tau_shear_out = 0.0_wp
18287
18288 do i_dim = 1, num_dims
18289 do j_dim = 1, num_dims
18290 tau_shear_out(i_dim, j_dim) = (vel_grad_avg(j_dim, i_dim) + vel_grad_avg(i_dim, j_dim))/re_shear
18291 if (i_dim == j_dim) then
18292 tau_shear_out(i_dim, j_dim) = tau_shear_out(i_dim, j_dim) - (2.0_wp/3.0_wp)*divergence_v/re_shear
18293 end if
18294 end do
18295 end do
18296
18297 end subroutine s_calculate_shear_stress_tensor
18298
18299 !> Compute bulk stress tensor components (diagonal only)
18300 subroutine s_calculate_bulk_stress_tensor(Re_bulk, divergence_v, tau_bulk_out)
18301
18302
18303# 4436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18304#if MFC_OpenACC
18305# 4436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18306!$acc routine seq
18307# 4436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18308#elif MFC_OpenMP
18309# 4436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18310
18311# 4436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18312
18313# 4436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18314!$omp declare target device_type(any)
18315# 4436 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18316#endif
18317
18318 ! Arguments
18319 real(wp), intent(in) :: Re_bulk
18320 real(wp), intent(in) :: divergence_v
18321# 4444 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18322 real(wp), dimension(num_dims, num_dims), intent(out) :: tau_bulk_out
18323# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18324
18325 ! Local variables
18326 integer :: i_dim !< Loop iterator for diagonal components.
18327 tau_bulk_out = 0.0_wp
18328
18329 do i_dim = 1, num_dims
18330 tau_bulk_out(i_dim, i_dim) = divergence_v/re_bulk
18331 end do
18332
18333 end subroutine s_calculate_bulk_stress_tensor
18334
18335 !> Deallocation and/or disassociation procedures that are needed to finalize the selected Riemann problem solver
18336 subroutine s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir)
18337
18338 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
18339 integer, intent(in) :: norm_dir
18340 integer :: i, j, k, l !< Generic loop iterators
18341 ! Reshaping Outputted Data in y-direction
18342
18343 if (norm_dir == 2) then
18344
18345# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18346
18347# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18348#if defined(MFC_OpenACC)
18349# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18350!$acc parallel loop collapse(4) gang vector default(present)
18351# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18352#elif defined(MFC_OpenMP)
18353# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18354
18355# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18356
18357# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18358
18359# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18360!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18361# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18362#endif
18363 do i = 1, sys_size
18364 do l = is3%beg, is3%end
18365 do j = is1%beg, is1%end
18366 do k = is2%beg, is2%end
18367 flux_vf(i)%sf(k, j, l) = flux_rsx_vf(k, j, l, i)
18368 end do
18369 end do
18370 end do
18371 end do
18372
18373# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18374#if defined(MFC_OpenACC)
18375# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18376!$acc end parallel loop
18377# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18378#elif defined(MFC_OpenMP)
18379# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18380
18381# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18382!$omp end target teams loop
18383# 4476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18384#endif
18385
18386 if (cyl_coord) then
18387
18388# 4479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18389
18390# 4479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18391#if defined(MFC_OpenACC)
18392# 4479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18393!$acc parallel loop collapse(4) gang vector default(present)
18394# 4479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18395#elif defined(MFC_OpenMP)
18396# 4479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18397
18398# 4479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18399
18400# 4479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18401
18402# 4479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18403!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18404# 4479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18405#endif
18406 do i = 1, sys_size
18407 do l = is3%beg, is3%end
18408 do j = is1%beg, is1%end
18409 do k = is2%beg, is2%end
18410 flux_gsrc_vf(i)%sf(k, j, l) = flux_gsrc_rsx_vf(k, j, l, i)
18411 end do
18412 end do
18413 end do
18414 end do
18415
18416# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18417#if defined(MFC_OpenACC)
18418# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18419!$acc end parallel loop
18420# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18421#elif defined(MFC_OpenMP)
18422# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18423
18424# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18425!$omp end target teams loop
18426# 4489 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18427#endif
18428 end if
18429
18430
18431# 4492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18432
18433# 4492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18434#if defined(MFC_OpenACC)
18435# 4492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18436!$acc parallel loop collapse(3) gang vector default(present)
18437# 4492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18438#elif defined(MFC_OpenMP)
18439# 4492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18440
18441# 4492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18442
18443# 4492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18444
18445# 4492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18446!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18447# 4492 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18448#endif
18449 do l = is3%beg, is3%end
18450 do j = is1%beg, is1%end
18451 do k = is2%beg, is2%end
18452 flux_src_vf(eqn_idx%adv%beg)%sf(k, j, l) = flux_src_rsx_vf(k, j, l, eqn_idx%adv%beg)
18453 end do
18454 end do
18455 end do
18456
18457# 4500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18458#if defined(MFC_OpenACC)
18459# 4500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18460!$acc end parallel loop
18461# 4500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18462#elif defined(MFC_OpenMP)
18463# 4500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18464
18465# 4500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18466!$omp end target teams loop
18467# 4500 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18468#endif
18469
18470 if (riemann_solver == 1 .or. riemann_solver == 4) then
18471
18472# 4503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18473
18474# 4503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18475#if defined(MFC_OpenACC)
18476# 4503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18477!$acc parallel loop collapse(4) gang vector default(present)
18478# 4503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18479#elif defined(MFC_OpenMP)
18480# 4503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18481
18482# 4503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18483
18484# 4503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18485
18486# 4503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18487!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18488# 4503 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18489#endif
18490 do i = eqn_idx%adv%beg + 1, eqn_idx%adv%end
18491 do l = is3%beg, is3%end
18492 do j = is1%beg, is1%end
18493 do k = is2%beg, is2%end
18494 flux_src_vf(i)%sf(k, j, l) = flux_src_rsx_vf(k, j, l, i)
18495 end do
18496 end do
18497 end do
18498 end do
18499
18500# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18501#if defined(MFC_OpenACC)
18502# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18503!$acc end parallel loop
18504# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18505#elif defined(MFC_OpenMP)
18506# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18507
18508# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18509!$omp end target teams loop
18510# 4513 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18511#endif
18512 end if
18513 ! Reshaping Outputted Data in z-direction
18514 else if (norm_dir == 3) then
18515
18516# 4517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18517
18518# 4517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18519#if defined(MFC_OpenACC)
18520# 4517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18521!$acc parallel loop collapse(4) gang vector default(present)
18522# 4517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18523#elif defined(MFC_OpenMP)
18524# 4517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18525
18526# 4517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18527
18528# 4517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18529
18530# 4517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18531!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18532# 4517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18533#endif
18534 do i = 1, sys_size
18535 do j = is1%beg, is1%end
18536 do k = is2%beg, is2%end
18537 do l = is3%beg, is3%end
18538 flux_vf(i)%sf(l, k, j) = flux_rsx_vf(l, k, j, i)
18539 end do
18540 end do
18541 end do
18542 end do
18543
18544# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18545#if defined(MFC_OpenACC)
18546# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18547!$acc end parallel loop
18548# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18549#elif defined(MFC_OpenMP)
18550# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18551
18552# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18553!$omp end target teams loop
18554# 4527 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18555#endif
18556 if (grid_geometry == 3) then
18557
18558# 4529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18559
18560# 4529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18561#if defined(MFC_OpenACC)
18562# 4529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18563!$acc parallel loop collapse(4) gang vector default(present)
18564# 4529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18565#elif defined(MFC_OpenMP)
18566# 4529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18567
18568# 4529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18569
18570# 4529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18571
18572# 4529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18573!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18574# 4529 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18575#endif
18576 do i = 1, sys_size
18577 do j = is1%beg, is1%end
18578 do k = is2%beg, is2%end
18579 do l = is3%beg, is3%end
18580 flux_gsrc_vf(i)%sf(l, k, j) = flux_gsrc_rsx_vf(l, k, j, i)
18581 end do
18582 end do
18583 end do
18584 end do
18585
18586# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18587#if defined(MFC_OpenACC)
18588# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18589!$acc end parallel loop
18590# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18591#elif defined(MFC_OpenMP)
18592# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18593
18594# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18595!$omp end target teams loop
18596# 4539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18597#endif
18598 end if
18599
18600
18601# 4542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18602
18603# 4542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18604#if defined(MFC_OpenACC)
18605# 4542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18606!$acc parallel loop collapse(3) gang vector default(present)
18607# 4542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18608#elif defined(MFC_OpenMP)
18609# 4542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18610
18611# 4542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18612
18613# 4542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18614
18615# 4542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18616!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18617# 4542 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18618#endif
18619 do j = is1%beg, is1%end
18620 do k = is2%beg, is2%end
18621 do l = is3%beg, is3%end
18622 flux_src_vf(eqn_idx%adv%beg)%sf(l, k, j) = flux_src_rsx_vf(l, k, j, eqn_idx%adv%beg)
18623 end do
18624 end do
18625 end do
18626
18627# 4550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18628#if defined(MFC_OpenACC)
18629# 4550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18630!$acc end parallel loop
18631# 4550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18632#elif defined(MFC_OpenMP)
18633# 4550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18634
18635# 4550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18636!$omp end target teams loop
18637# 4550 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18638#endif
18639
18640 if (riemann_solver == 1 .or. riemann_solver == 4) then
18641
18642# 4553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18643
18644# 4553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18645#if defined(MFC_OpenACC)
18646# 4553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18647!$acc parallel loop collapse(4) gang vector default(present)
18648# 4553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18649#elif defined(MFC_OpenMP)
18650# 4553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18651
18652# 4553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18653
18654# 4553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18655
18656# 4553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18657!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18658# 4553 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18659#endif
18660 do i = eqn_idx%adv%beg + 1, eqn_idx%adv%end
18661 do j = is1%beg, is1%end
18662 do k = is2%beg, is2%end
18663 do l = is3%beg, is3%end
18664 flux_src_vf(i)%sf(l, k, j) = flux_src_rsx_vf(l, k, j, i)
18665 end do
18666 end do
18667 end do
18668 end do
18669
18670# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18671#if defined(MFC_OpenACC)
18672# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18673!$acc end parallel loop
18674# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18675#elif defined(MFC_OpenMP)
18676# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18677
18678# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18679!$omp end target teams loop
18680# 4563 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18681#endif
18682 end if
18683 else if (norm_dir == 1) then
18684
18685# 4566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18686
18687# 4566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18688#if defined(MFC_OpenACC)
18689# 4566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18690!$acc parallel loop collapse(4) gang vector default(present)
18691# 4566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18692#elif defined(MFC_OpenMP)
18693# 4566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18694
18695# 4566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18696
18697# 4566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18698
18699# 4566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18700!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18701# 4566 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18702#endif
18703 do i = 1, sys_size
18704 do l = is3%beg, is3%end
18705 do k = is2%beg, is2%end
18706 do j = is1%beg, is1%end
18707 flux_vf(i)%sf(j, k, l) = flux_rsx_vf(j, k, l, i)
18708 end do
18709 end do
18710 end do
18711 end do
18712
18713# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18714#if defined(MFC_OpenACC)
18715# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18716!$acc end parallel loop
18717# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18718#elif defined(MFC_OpenMP)
18719# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18720
18721# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18722!$omp end target teams loop
18723# 4576 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18724#endif
18725
18726
18727# 4578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18728
18729# 4578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18730#if defined(MFC_OpenACC)
18731# 4578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18732!$acc parallel loop collapse(3) gang vector default(present)
18733# 4578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18734#elif defined(MFC_OpenMP)
18735# 4578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18736
18737# 4578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18738
18739# 4578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18740
18741# 4578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18742!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18743# 4578 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18744#endif
18745 do l = is3%beg, is3%end
18746 do k = is2%beg, is2%end
18747 do j = is1%beg, is1%end
18748 flux_src_vf(eqn_idx%adv%beg)%sf(j, k, l) = flux_src_rsx_vf(j, k, l, eqn_idx%adv%beg)
18749 end do
18750 end do
18751 end do
18752
18753# 4586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18754#if defined(MFC_OpenACC)
18755# 4586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18756!$acc end parallel loop
18757# 4586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18758#elif defined(MFC_OpenMP)
18759# 4586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18760
18761# 4586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18762!$omp end target teams loop
18763# 4586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18764#endif
18765
18766 if (riemann_solver == 1 .or. riemann_solver == 4) then
18767
18768# 4589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18769
18770# 4589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18771#if defined(MFC_OpenACC)
18772# 4589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18773!$acc parallel loop collapse(4) gang vector default(present)
18774# 4589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18775#elif defined(MFC_OpenMP)
18776# 4589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18777
18778# 4589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18779
18780# 4589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18781
18782# 4589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18783!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18784# 4589 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18785#endif
18786 do i = eqn_idx%adv%beg + 1, eqn_idx%adv%end
18787 do l = is3%beg, is3%end
18788 do k = is2%beg, is2%end
18789 do j = is1%beg, is1%end
18790 flux_src_vf(i)%sf(j, k, l) = flux_src_rsx_vf(j, k, l, i)
18791 end do
18792 end do
18793 end do
18794 end do
18795
18796# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18797#if defined(MFC_OpenACC)
18798# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18799!$acc end parallel loop
18800# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18801#elif defined(MFC_OpenMP)
18802# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18803
18804# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18805!$omp end target teams loop
18806# 4599 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18807#endif
18808 end if
18809 end if
18810
18811 end subroutine s_finalize_riemann_solver
18812
18813 !> Module deallocation and/or disassociation procedures
18814 impure subroutine s_finalize_riemann_solvers_module
18815
18816 if (viscous) then
18817#ifdef MFC_DEBUG
18818# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18819 block
18820# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18821 use iso_fortran_env, only: output_unit
18822# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18823
18824# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18825 print *, 'm_riemann_solvers.fpp:4609: ', '@:DEALLOCATE(Re_avg_rsx_vf)'
18826# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18827
18828# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18829 call flush (output_unit)
18830# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18831 end block
18832# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18833#endif
18834# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18835
18836# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18837#if defined(MFC_OpenACC)
18838# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18839!$acc exit data delete(Re_avg_rsx_vf)
18840# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18841#elif defined(MFC_OpenMP)
18842# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18843!$omp target exit data map(release:Re_avg_rsx_vf)
18844# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18845#endif
18846# 4609 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18847 deallocate (re_avg_rsx_vf)
18848 end if
18849#ifdef MFC_DEBUG
18850# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18851 block
18852# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18853 use iso_fortran_env, only: output_unit
18854# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18855
18856# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18857 print *, 'm_riemann_solvers.fpp:4611: ', '@:DEALLOCATE(vel_src_rsx_vf)'
18858# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18859
18860# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18861 call flush (output_unit)
18862# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18863 end block
18864# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18865#endif
18866# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18867
18868# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18869#if defined(MFC_OpenACC)
18870# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18871!$acc exit data delete(vel_src_rsx_vf)
18872# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18873#elif defined(MFC_OpenMP)
18874# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18875!$omp target exit data map(release:vel_src_rsx_vf)
18876# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18877#endif
18878# 4611 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18879 deallocate (vel_src_rsx_vf)
18880#ifdef MFC_DEBUG
18881# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18882 block
18883# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18884 use iso_fortran_env, only: output_unit
18885# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18886
18887# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18888 print *, 'm_riemann_solvers.fpp:4612: ', '@:DEALLOCATE(flux_rsx_vf)'
18889# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18890
18891# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18892 call flush (output_unit)
18893# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18894 end block
18895# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18896#endif
18897# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18898
18899# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18900#if defined(MFC_OpenACC)
18901# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18902!$acc exit data delete(flux_rsx_vf)
18903# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18904#elif defined(MFC_OpenMP)
18905# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18906!$omp target exit data map(release:flux_rsx_vf)
18907# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18908#endif
18909# 4612 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18910 deallocate (flux_rsx_vf)
18911#ifdef MFC_DEBUG
18912# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18913 block
18914# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18915 use iso_fortran_env, only: output_unit
18916# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18917
18918# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18919 print *, 'm_riemann_solvers.fpp:4613: ', '@:DEALLOCATE(flux_src_rsx_vf)'
18920# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18921
18922# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18923 call flush (output_unit)
18924# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18925 end block
18926# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18927#endif
18928# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18929
18930# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18931#if defined(MFC_OpenACC)
18932# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18933!$acc exit data delete(flux_src_rsx_vf)
18934# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18935#elif defined(MFC_OpenMP)
18936# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18937!$omp target exit data map(release:flux_src_rsx_vf)
18938# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18939#endif
18940# 4613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18941 deallocate (flux_src_rsx_vf)
18942#ifdef MFC_DEBUG
18943# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18944 block
18945# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18946 use iso_fortran_env, only: output_unit
18947# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18948
18949# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18950 print *, 'm_riemann_solvers.fpp:4614: ', '@:DEALLOCATE(flux_gsrc_rsx_vf)'
18951# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18952
18953# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18954 call flush (output_unit)
18955# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18956 end block
18957# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18958#endif
18959# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18960
18961# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18962#if defined(MFC_OpenACC)
18963# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18964!$acc exit data delete(flux_gsrc_rsx_vf)
18965# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18966#elif defined(MFC_OpenMP)
18967# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18968!$omp target exit data map(release:flux_gsrc_rsx_vf)
18969# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18970#endif
18971# 4614 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18972 deallocate (flux_gsrc_rsx_vf)
18973 if (qbmm) then
18974#ifdef MFC_DEBUG
18975# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18976 block
18977# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18978 use iso_fortran_env, only: output_unit
18979# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18980
18981# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18982 print *, 'm_riemann_solvers.fpp:4616: ', '@:DEALLOCATE(mom_sp_rsx_vf)'
18983# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18984
18985# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18986 call flush (output_unit)
18987# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18988 end block
18989# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18990#endif
18991# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18992
18993# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18994#if defined(MFC_OpenACC)
18995# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18996!$acc exit data delete(mom_sp_rsx_vf)
18997# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18998#elif defined(MFC_OpenMP)
18999# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19000!$omp target exit data map(release:mom_sp_rsx_vf)
19001# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19002#endif
19003# 4616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19004 deallocate (mom_sp_rsx_vf)
19005 end if
19006
19007 end subroutine s_finalize_riemann_solvers_module
19008
19009end 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:371
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:317
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:328
m_global_parameters::bubbles_euler
logical bubbles_euler
Bubbles euler on/off.
Definition m_global_parameters.fpp.f90:1073
m_global_parameters::re_size
integer, dimension(2) re_size
Definition m_global_parameters.fpp.f90:872
m_global_parameters::bulk_stress
logical bulk_stress
Bulk stresses.
Definition m_global_parameters.fpp.f90:508
m_global_parameters::grid_geometry
integer grid_geometry
Definition m_global_parameters.fpp.f90:366
m_global_parameters::wave_speeds
integer wave_speeds
Wave speeds estimation method.
Definition m_global_parameters.fpp.f90:483
m_global_parameters::cont_damage
logical cont_damage
Continuum damage modeling.
Definition m_global_parameters.fpp.f90:509
m_global_parameters::hypoelasticity
logical hypoelasticity
hypoelasticity modeling
Definition m_global_parameters.fpp.f90:488
m_global_parameters::avg_state
integer avg_state
Average state evaluation method.
Definition m_global_parameters.fpp.f90:484
m_global_parameters::chemistry
logical, parameter chemistry
Chemistry modeling.
Definition m_global_parameters.fpp.f90:506
m_global_parameters::num_fluids
integer num_fluids
number of fluids in the simulation
Definition m_global_parameters.fpp.f90:451
m_global_parameters::re_idx
integer, dimension(:,:), allocatable re_idx
Definition m_global_parameters.fpp.f90:874
m_global_parameters::weno_re_flux
logical weno_re_flux
WENO reconstruct velocity gradients for viscous stress tensor.
Definition m_global_parameters.fpp.f90:480
m_global_parameters::hyper_cleaning_speed
real(wp) hyper_cleaning_speed
Hyperbolic cleaning wave speed (c_h).
Definition m_global_parameters.fpp.f90:1375
m_global_parameters::sys_size
integer sys_size
Number of unknowns in system of eqns.
Definition m_global_parameters.fpp.f90:822
m_global_parameters::weight
real(wp), dimension(:), allocatable weight
Simpson quadrature weights.
Definition m_global_parameters.fpp.f90:1059
m_global_parameters::cyl_coord
logical cyl_coord
Definition m_global_parameters.fpp.f90:365
m_global_parameters::dir_idx
integer, dimension(3) dir_idx
Definition m_global_parameters.fpp.f90:910
m_global_parameters::viscous
logical viscous
Viscous effects.
Definition m_global_parameters.fpp.f90:463
m_global_parameters::riemann_solver
integer riemann_solver
Riemann solver algorithm.
Definition m_global_parameters.fpp.f90:481
m_global_parameters::model_eqns
integer model_eqns
Multicomponent flow model.
Definition m_global_parameters.fpp.f90:434
m_global_parameters::hyperelasticity
logical hyperelasticity
hyperelasticity modeling
Definition m_global_parameters.fpp.f90:489
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:960
m_global_parameters::dir_idx_tau
integer, dimension(3) dir_idx_tau
used for hypoelasticity=true
Definition m_global_parameters.fpp.f90:912
m_global_parameters::num_dims
integer num_dims
Number of spatial dimensions.
Definition m_global_parameters.fpp.f90:436
m_global_parameters::r0
real(wp), dimension(:), allocatable r0
Bubble sizes.
Definition m_global_parameters.fpp.f90:1060
m_global_parameters::chem_params
type(chemistry_parameters) chem_params
Definition m_global_parameters.fpp.f90:1178
m_global_parameters::num_vels
integer num_vels
Number of velocity components (different from num_dims for mhd).
Definition m_global_parameters.fpp.f90:437
m_global_parameters::polytropic
logical polytropic
Polytropic switch.
Definition m_global_parameters.fpp.f90:1074
m_global_parameters::qbmm
logical qbmm
Quadrature moment method.
Definition m_global_parameters.fpp.f90:1132
m_global_parameters::hyper_cleaning
logical hyper_cleaning
Hyperbolic cleaning for MHD for divB=0.
Definition m_global_parameters.fpp.f90:510
m_global_parameters::bx0
real(wp) bx0
Constant magnetic field in the x-direction (1D).
Definition m_global_parameters.fpp.f90:1341
m_global_parameters::b_size
integer b_size
Number of elements in the symmetric b tensor, plus one.
Definition m_global_parameters.fpp.f90:825
m_global_parameters::qvs
real(wp), dimension(:), allocatable qvs
Definition m_global_parameters.fpp.f90:1293
m_global_parameters::pi_infs
real(wp), dimension(:), allocatable pi_infs
Definition m_global_parameters.fpp.f90:1293
m_global_parameters::adv_n
logical adv_n
Solve the number density equation and compute alpha from number density.
Definition m_global_parameters.fpp.f90:1088
m_global_parameters::dir_flg
real(wp), dimension(3) dir_flg
Definition m_global_parameters.fpp.f90:911
m_global_parameters::mhd
logical mhd
Magnetohydrodynamics.
Definition m_global_parameters.fpp.f90:457
m_global_parameters::shear_indices
integer, dimension(3) shear_indices
Indices of the stress components that represent shear stress.
Definition m_global_parameters.fpp.f90:941
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:352
m_global_parameters::surface_tension
logical surface_tension
Definition m_global_parameters.fpp.f90:1279
m_global_parameters::elasticity
logical elasticity
elasticity modeling, true for hyper or hypo
Definition m_global_parameters.fpp.f90:505
m_global_parameters::nb
integer nb
Number of eq. bubble sizes.
Definition m_global_parameters.fpp.f90:1040
m_global_parameters::mpp_lim
logical mpp_lim
Mixture physical parameters (MPP) limits.
Definition m_global_parameters.fpp.f90:439
m_global_parameters::low_mach
integer low_mach
Low Mach number fix to HLLC Riemann solver.
Definition m_global_parameters.fpp.f90:482
m_global_parameters::shear_stress
logical shear_stress
Shear stresses.
Definition m_global_parameters.fpp.f90:507
m_global_parameters::relativity
logical relativity
Relativity (only for MHD).
Definition m_global_parameters.fpp.f90:458
m_global_parameters::gammas
real(wp), dimension(:), allocatable gammas
Definition m_global_parameters.fpp.f90:1293
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:823
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:437
m_riemann_solvers::re_avg_rsx_vf
real(wp), dimension(:,:,:,:), allocatable re_avg_rsx_vf
Definition m_riemann_solvers.fpp.f90:422
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:17896
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:3631
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:18109
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:18301
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:16396
m_riemann_solvers::res_gs
real(wp), dimension(:,:), allocatable res_gs
Definition m_riemann_solvers.fpp.f90:466
m_riemann_solvers::vel_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable vel_src_rsx_vf
Definition m_riemann_solvers.fpp.f90:396
m_riemann_solvers::is1
type(int_bounds_info) is1
Definition m_riemann_solvers.fpp.f90:437
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:18337
m_riemann_solvers::isx
type(int_bounds_info) isx
Definition m_riemann_solvers.fpp.f90:438
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:18815
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:18258
m_riemann_solvers::is3
type(int_bounds_info) is3
Definition m_riemann_solvers.fpp.f90:437
m_riemann_solvers::flux_src_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_src_rsx_vf
Definition m_riemann_solvers.fpp.f90:363
m_riemann_solvers::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:487
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:17475
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:6424
m_riemann_solvers::mom_sp_rsx_vf
real(wp), dimension(:,:,:,:), allocatable mom_sp_rsx_vf
Definition m_riemann_solvers.fpp.f90:409
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:380
m_riemann_solvers::flux_rsx_vf
real(wp), dimension(:,:,:,:), allocatable flux_rsx_vf
The cell-boundary values of the fluxes (src - source) that are computed through the chosen Riemann pr...
Definition m_riemann_solvers.fpp.f90:363
m_riemann_solvers::isy
type(int_bounds_info) isy
Definition m_riemann_solvers.fpp.f90:438
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:555
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:16062
m_riemann_solvers::isz
type(int_bounds_info) isz
Definition m_riemann_solvers.fpp.f90:438
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:15285
m_riemann_solvers::gs_rs
real(wp), dimension(:), allocatable gs_rs
Definition m_riemann_solvers.fpp.f90:453
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:532
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