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# 207 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
120
121# 232 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
122
123# 243 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
124
125# 245 "/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# 283 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
129
130# 293 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
131
132# 303 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
133
134# 312 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
135
136# 329 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
137
138# 339 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
139
140# 346 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
141
142# 352 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
143
144# 358 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
145
146# 364 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
147
148# 370 "/home/runner/work/MFC/MFC/src/common/include/omp_macros.fpp"
149
150# 376 "/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# 192 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
220
221# 213 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
222
223# 241 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
224
225# 256 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
226
227# 266 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
228
229# 275 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
230
231# 291 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
232
233# 301 "/home/runner/work/MFC/MFC/src/common/include/acc_macros.fpp"
234
235# 308 "/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# 21 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
240
241# 37 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
242
243# 50 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
244
245# 76 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
246
247# 91 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
248
249# 102 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
250
251# 115 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
252
253# 143 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
254
255# 154 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
256
257# 165 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
258
259# 176 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
260
261# 187 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
262
263# 198 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
264
265# 208 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
266
267# 214 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
268
269# 220 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
270
271# 226 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
272
273# 232 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
274
275# 234 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
276# 235 "/home/runner/work/MFC/MFC/src/common/include/parallel_macros.fpp"
277! New line at end of file is required for FYPP
278# 2 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp" 2
279
280# 14 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
281
282! Caution:
283! This macro requires the use of a binding script to set CUDA_VISIBLE_DEVICES, such that we have one GPU device per MPI rank.
284! That's because for both cudaMemAdvise (preferred location) and cudaMemPrefetchAsync we use location = device_id = 0.
285! For an example see misc/nvidia_uvm/bind.sh.
286# 63 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
287
288# 81 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
289
290# 88 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
291
292# 111 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
293
294# 127 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
295
296# 153 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
297
298# 159 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
299
300# 167 "/home/runner/work/MFC/MFC/src/common/include/macros.fpp"
301! New line at end of file is required for FYPP
302# 9 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp" 2
303# 1 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp" 1
304# 14 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
305
306# 89 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
307
308# 101 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
309
310# 131 "/home/runner/work/MFC/MFC/src/simulation/include/inline_riemann.fpp"
311# 10 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp" 2
312
313module m_riemann_solvers
314
315 use m_derived_types !< definitions of the derived types
316
317 use m_global_parameters !< definitions of the global parameters
318
319 use m_mpi_proxy !< message passing interface (mpi) module proxy
320
321 use m_variables_conversion !< state variables type conversion procedures
322
323 use m_bubbles !< to get the bubble wall pressure function
324
325 use m_bubbles_ee
326
327 use m_surface_tension !< to get the capillary fluxes
328
329 use m_helper_basic !< functions to compare floating point numbers
330
331 use m_chemistry
332
333 use m_thermochem, only: &
334 gas_constant, get_mixture_molecular_weight, &
335 get_mixture_specific_heat_cv_mass, get_mixture_energy_mass, &
336 get_species_specific_heats_r, get_species_enthalpies_rt, &
337 get_mixture_specific_heat_cp_mass
338
339# 40 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
340
341 implicit none
342
343 private; public :: s_initialize_riemann_solvers_module, &
344 s_riemann_solver, &
345 s_hll_riemann_solver, &
346 s_hllc_riemann_solver, &
347 s_hlld_riemann_solver, &
348 s_lf_riemann_solver, &
349 s_finalize_riemann_solvers_module
350
351 !> The cell-boundary values of the fluxes (src - source) that are computed
352 !! through the chosen Riemann problem solver, and the direct evaluation of
353 !! source terms, by using the left and right states given in qK_prim_rs_vf,
354 !! dqK_prim_ds_vf where ds = dx, dy or dz.
355 !> @{
356
357 real(wp), allocatable, dimension(:, :, :, :) :: flux_rsx_vf, flux_src_rsx_vf
358 real(wp), allocatable, dimension(:, :, :, :) :: flux_rsy_vf, flux_src_rsy_vf
359 real(wp), allocatable, dimension(:, :, :, :) :: flux_rsz_vf, flux_src_rsz_vf
360
361# 60 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
362#if defined(MFC_OpenACC)
363# 60 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
364!$acc declare create(flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf)
365# 60 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
366#elif defined(MFC_OpenMP)
367# 60 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
368!$omp declare target (flux_rsx_vf, flux_src_rsx_vf, flux_rsy_vf, flux_src_rsy_vf, flux_rsz_vf, flux_src_rsz_vf)
369# 60 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
370#endif
371 !> @}
372
373 !> The cell-boundary values of the geometrical source flux that are computed
374 !! through the chosen Riemann problem solver by using the left and right
375 !! states given in qK_prim_rs_vf. Currently 2D axisymmetric for inviscid only.
376 !> @{
377
378 real(wp), allocatable, dimension(:, :, :, :) :: flux_gsrc_rsx_vf !<
379 real(wp), allocatable, dimension(:, :, :, :) :: flux_gsrc_rsy_vf !<
380 real(wp), allocatable, dimension(:, :, :, :) :: flux_gsrc_rsz_vf !<
381
382# 71 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
383#if defined(MFC_OpenACC)
384# 71 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
385!$acc declare create(flux_gsrc_rsx_vf, flux_gsrc_rsy_vf, flux_gsrc_rsz_vf)
386# 71 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
387#elif defined(MFC_OpenMP)
388# 71 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
389!$omp declare target (flux_gsrc_rsx_vf, flux_gsrc_rsy_vf, flux_gsrc_rsz_vf)
390# 71 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
391#endif
392 !> @}
393
394 ! The cell-boundary values of the velocity. vel_src_rs_vf is determined as
395 ! part of Riemann problem solution and is used to evaluate the source flux.
396
397 real(wp), allocatable, dimension(:, :, :, :) :: vel_src_rsx_vf
398 real(wp), allocatable, dimension(:, :, :, :) :: vel_src_rsy_vf
399 real(wp), allocatable, dimension(:, :, :, :) :: vel_src_rsz_vf
400
401# 80 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
402#if defined(MFC_OpenACC)
403# 80 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
404!$acc declare create(vel_src_rsx_vf, vel_src_rsy_vf, vel_src_rsz_vf)
405# 80 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
406#elif defined(MFC_OpenMP)
407# 80 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
408!$omp declare target (vel_src_rsx_vf, vel_src_rsy_vf, vel_src_rsz_vf)
409# 80 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
410#endif
411
412 real(wp), allocatable, dimension(:, :, :, :) :: mom_sp_rsx_vf
413 real(wp), allocatable, dimension(:, :, :, :) :: mom_sp_rsy_vf
414 real(wp), allocatable, dimension(:, :, :, :) :: mom_sp_rsz_vf
415
416# 85 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
417#if defined(MFC_OpenACC)
418# 85 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
419!$acc declare create(mom_sp_rsx_vf, mom_sp_rsy_vf, mom_sp_rsz_vf)
420# 85 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
421#elif defined(MFC_OpenMP)
422# 85 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
423!$omp declare target (mom_sp_rsx_vf, mom_sp_rsy_vf, mom_sp_rsz_vf)
424# 85 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
425#endif
426
427 real(wp), allocatable, dimension(:, :, :, :) :: re_avg_rsx_vf
428 real(wp), allocatable, dimension(:, :, :, :) :: re_avg_rsy_vf
429 real(wp), allocatable, dimension(:, :, :, :) :: re_avg_rsz_vf
430
431# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
432#if defined(MFC_OpenACC)
433# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
434!$acc declare create(Re_avg_rsx_vf, Re_avg_rsy_vf, Re_avg_rsz_vf)
435# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
436#elif defined(MFC_OpenMP)
437# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
438!$omp declare target (Re_avg_rsx_vf, Re_avg_rsy_vf, Re_avg_rsz_vf)
439# 90 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
440#endif
441
442 !> @name Indical bounds in the s1-, s2- and s3-directions
443 !> @{
444 type(int_bounds_info) :: is1, is2, is3
445 type(int_bounds_info) :: isx, isy, isz
446 !> @}
447
448
449# 98 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
450#if defined(MFC_OpenACC)
451# 98 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
452!$acc declare create(is1, is2, is3, isx, isy, isz)
453# 98 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
454#elif defined(MFC_OpenMP)
455# 98 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
456!$omp declare target (is1, is2, is3, isx, isy, isz)
457# 98 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
458#endif
459
460 real(wp), allocatable, dimension(:) :: gs_rs
461
462# 101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
463#if defined(MFC_OpenACC)
464# 101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
465!$acc declare create(Gs_rs)
466# 101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
467#elif defined(MFC_OpenMP)
468# 101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
469!$omp declare target (Gs_rs)
470# 101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
471#endif
472
473 real(wp), allocatable, dimension(:, :) :: res_gs
474
475# 104 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
476#if defined(MFC_OpenACC)
477# 104 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
478!$acc declare create(Res_gs)
479# 104 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
480#elif defined(MFC_OpenMP)
481# 104 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
482!$omp declare target (Res_gs)
483# 104 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
484#endif
485
486contains
487
488 !> Dispatch to the subroutines that are utilized to compute the
489 !! Riemann problem solution. For additional information please reference:
490 !! 1) s_hll_riemann_solver
491 !! 2) s_hllc_riemann_solver
492 !! 3) s_exact_riemann_solver
493 !! 4) s_hlld_riemann_solver
494 !! @param qL_prim_rsx_vf Left WENO-reconstructed cell-boundary values (x-dir)
495 !! @param qL_prim_rsy_vf Left WENO-reconstructed cell-boundary values (y-dir)
496 !! @param qL_prim_rsz_vf Left WENO-reconstructed cell-boundary values (z-dir)
497 !! @param dqL_prim_dx_vf The left WENO-reconstructed cell-boundary values of the
498 !! first-order x-dir spatial derivatives
499 !! @param dqL_prim_dy_vf The left WENO-reconstructed cell-boundary values of the
500 !! first-order y-dir spatial derivatives
501 !! @param dqL_prim_dz_vf The left WENO-reconstructed cell-boundary values of the
502 !! first-order z-dir spatial derivatives
503 !! @param qL_prim_vf The left WENO-reconstructed cell-boundary values of the
504 !! cell-average primitive variables
505 !! @param qR_prim_rsx_vf Right WENO-reconstructed cell-boundary values (x-dir)
506 !! @param qR_prim_rsy_vf Right WENO-reconstructed cell-boundary values (y-dir)
507 !! @param qR_prim_rsz_vf Right WENO-reconstructed cell-boundary values (z-dir)
508 !! @param dqR_prim_dx_vf The right WENO-reconstructed cell-boundary values of the
509 !! first-order x-dir spatial derivatives
510 !! @param dqR_prim_dy_vf The right WENO-reconstructed cell-boundary values of the
511 !! first-order y-dir spatial derivatives
512 !! @param dqR_prim_dz_vf The right WENO-reconstructed cell-boundary values of the
513 !! first-order z-dir spatial derivatives
514 !! @param qR_prim_vf The right WENO-reconstructed cell-boundary values of the
515 !! cell-average primitive variables
516 !! @param q_prim_vf Cell-averaged primitive variables
517 !! @param flux_vf Intra-cell fluxes
518 !! @param flux_src_vf Intra-cell fluxes sources
519 !! @param flux_gsrc_vf Intra-cell geometric fluxes sources
520 !! @param norm_dir Dir. splitting direction
521 !! @param ix Index bounds in the x-dir
522 !! @param iy Index bounds in the y-dir
523 !! @param iz Index bounds in the z-dir
524 subroutine s_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, &
525 dqL_prim_dy_vf, &
526 dqL_prim_dz_vf, &
527 qL_prim_vf, &
528 qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, &
529 dqR_prim_dy_vf, &
530 dqR_prim_dz_vf, &
531 qR_prim_vf, &
532 q_prim_vf, &
533 flux_vf, flux_src_vf, &
534 flux_gsrc_vf, &
535 norm_dir, ix, iy, iz)
536
537 real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(INOUT) :: ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf
538 type(scalar_field), dimension(sys_size), intent(IN) :: q_prim_vf
539
540 type(scalar_field), allocatable, dimension(:), intent(INOUT) :: ql_prim_vf, qr_prim_vf
541
542 type(scalar_field), &
543 allocatable, dimension(:), &
544 intent(INOUT) :: dql_prim_dx_vf, dqr_prim_dx_vf, &
545 dql_prim_dy_vf, dqr_prim_dy_vf, &
546 dql_prim_dz_vf, dqr_prim_dz_vf
547
548 type(scalar_field), &
549 dimension(sys_size), &
550 intent(INOUT) :: flux_vf, flux_src_vf, flux_gsrc_vf
551
552 integer, intent(IN) :: norm_dir
553
554 type(int_bounds_info), intent(IN) :: ix, iy, iz
555
556# 177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
557 if (riemann_solver == 1) then
558 call s_hll_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
559 dql_prim_dy_vf, &
560 dql_prim_dz_vf, &
561 ql_prim_vf, &
562 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
563 dqr_prim_dy_vf, &
564 dqr_prim_dz_vf, &
565 qr_prim_vf, &
566 q_prim_vf, &
567 flux_vf, flux_src_vf, &
568 flux_gsrc_vf, &
569 norm_dir, ix, iy, iz)
570 end if
571# 177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
572 if (riemann_solver == 2) then
573 call s_hllc_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
574 dql_prim_dy_vf, &
575 dql_prim_dz_vf, &
576 ql_prim_vf, &
577 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
578 dqr_prim_dy_vf, &
579 dqr_prim_dz_vf, &
580 qr_prim_vf, &
581 q_prim_vf, &
582 flux_vf, flux_src_vf, &
583 flux_gsrc_vf, &
584 norm_dir, ix, iy, iz)
585 end if
586# 177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
587 if (riemann_solver == 4) then
588 call s_hlld_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
589 dql_prim_dy_vf, &
590 dql_prim_dz_vf, &
591 ql_prim_vf, &
592 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
593 dqr_prim_dy_vf, &
594 dqr_prim_dz_vf, &
595 qr_prim_vf, &
596 q_prim_vf, &
597 flux_vf, flux_src_vf, &
598 flux_gsrc_vf, &
599 norm_dir, ix, iy, iz)
600 end if
601# 177 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
602 if (riemann_solver == 5) then
603 call s_lf_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
604 dql_prim_dy_vf, &
605 dql_prim_dz_vf, &
606 ql_prim_vf, &
607 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
608 dqr_prim_dy_vf, &
609 dqr_prim_dz_vf, &
610 qr_prim_vf, &
611 q_prim_vf, &
612 flux_vf, flux_src_vf, &
613 flux_gsrc_vf, &
614 norm_dir, ix, iy, iz)
615 end if
616# 192 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
617
618 end subroutine s_riemann_solver
619
620 !> Dispatch to the subroutines that are utilized to compute
621 !! the viscous source fluxes for either Cartesian or cylindrical geometries.
622 !! For more information please refer to:
623 !! 1) s_compute_cartesian_viscous_source_flux
624 !! 2) s_compute_cylindrical_viscous_source_flux
625 subroutine s_compute_viscous_source_flux(velL_vf, &
626 dvelL_dx_vf, &
627 dvelL_dy_vf, &
628 dvelL_dz_vf, &
629 velR_vf, &
630 dvelR_dx_vf, &
631 dvelR_dy_vf, &
632 dvelR_dz_vf, &
633 flux_src_vf, &
634 norm_dir, &
635 ix, iy, iz)
636
637 type(scalar_field), &
638 dimension(num_vels), &
639 intent(IN) :: velL_vf, velR_vf, &
640 dvelL_dx_vf, dvelR_dx_vf, &
641 dvelL_dy_vf, dvelR_dy_vf, &
642 dvelL_dz_vf, dvelR_dz_vf
643
644 type(scalar_field), &
645 dimension(sys_size), &
646 intent(INOUT) :: flux_src_vf
647
648 integer, intent(IN) :: norm_dir
649
650 type(int_bounds_info), intent(IN) :: ix, iy, iz
651
652 if (grid_geometry == 3) then
653 call s_compute_cylindrical_viscous_source_flux(vell_vf, &
654 dvell_dx_vf, &
655 dvell_dy_vf, &
656 dvell_dz_vf, &
657 velr_vf, &
658 dvelr_dx_vf, &
659 dvelr_dy_vf, &
660 dvelr_dz_vf, &
661 flux_src_vf, &
662 norm_dir, &
663 ix, iy, iz)
664 else
665 call s_compute_cartesian_viscous_source_flux(dvell_dx_vf, &
666 dvell_dy_vf, &
667 dvell_dz_vf, &
668 dvelr_dx_vf, &
669 dvelr_dy_vf, &
670 dvelr_dz_vf, &
671 flux_src_vf, &
672 norm_dir)
673 end if
674 end subroutine s_compute_viscous_source_flux
675
676 !> @brief Computes intercell fluxes using the Harten-Lax-van Leer (HLL) approximate Riemann solver.
677 subroutine s_hll_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, &
678 dqL_prim_dy_vf, &
679 dqL_prim_dz_vf, &
680 qL_prim_vf, &
681 qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, &
682 dqR_prim_dy_vf, &
683 dqR_prim_dz_vf, &
684 qR_prim_vf, &
685 q_prim_vf, &
686 flux_vf, flux_src_vf, &
687 flux_gsrc_vf, &
688 norm_dir, ix, iy, iz)
689
690 real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(inout) :: ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf
691 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
692
693 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
694
695 type(scalar_field), &
696 allocatable, dimension(:), &
697 intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, &
698 dql_prim_dy_vf, dqr_prim_dy_vf, &
699 dql_prim_dz_vf, dqr_prim_dz_vf
700
701 ! Intercell fluxes
702 type(scalar_field), &
703 dimension(sys_size), &
704 intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
705 real(wp) :: flux_tau_l, flux_tau_r
706
707 integer, intent(in) :: norm_dir
708 type(int_bounds_info), intent(in) :: ix, iy, iz
709# 292 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
710 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
711 real(wp), dimension(num_vels) :: vel_l, vel_r
712 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
713 real(wp), dimension(num_species) :: ys_l, ys_r
714 real(wp), dimension(num_species) :: cp_il, cp_ir, xs_l, xs_r, gamma_il, gamma_ir
715 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
716# 299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
717 real(wp) :: rho_l, rho_r
718 real(wp) :: pres_l, pres_r
719 real(wp) :: e_l, e_r
720 real(wp) :: h_l, h_r
721 real(wp) :: cp_avg, cv_avg, t_avg, eps, c_sum_yi_phi
722 real(wp) :: t_l, t_r
723 real(wp) :: y_l, y_r
724 real(wp) :: mw_l, mw_r
725 real(wp) :: r_gas_l, r_gas_r
726 real(wp) :: cp_l, cp_r
727 real(wp) :: cv_l, cv_r
728 real(wp) :: gamm_l, gamm_r
729 real(wp) :: gamma_l, gamma_r
730 real(wp) :: pi_inf_l, pi_inf_r
731 real(wp) :: qv_l, qv_r
732 real(wp) :: c_l, c_r
733 real(wp), dimension(6) :: tau_e_l, tau_e_r
734 real(wp) :: g_l, g_r
735 real(wp), dimension(2) :: re_l, re_r
736 real(wp), dimension(3) :: xi_field_l, xi_field_r
737
738 real(wp) :: rho_avg
739 real(wp) :: h_avg
740 real(wp) :: qv_avg
741 real(wp) :: gamma_avg
742 real(wp) :: c_avg
743
744 real(wp) :: s_l, s_r, s_m, s_p, s_s
745 real(wp) :: xi_m, xi_p
746
747 real(wp) :: ptilde_l, ptilde_r
748 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
749 real(wp) :: vel_l_tmp, vel_r_tmp
750 real(wp) :: ms_l, ms_r, pres_sl, pres_sr
751 real(wp) :: alpha_l_sum, alpha_r_sum
752 real(wp) :: zcoef, pcorr !< low Mach number correction
753
754 type(riemann_states) :: c_fast, pres_mag
755 type(riemann_states_vec3) :: b
756
757 type(riemann_states) :: ga ! Gamma (Lorentz factor)
758 type(riemann_states) :: vdotb, b2
759 type(riemann_states_vec3) :: b4 ! 4-magnetic field components (spatial: b4x, b4y, b4z)
760 type(riemann_states_vec3) :: cm ! Conservative momentum variables
761
762 integer :: i, j, k, l, q !< Generic loop iterators
763
764 ! Populating the buffers of the left and right Riemann problem
765 ! states variables, based on the choice of boundary conditions
766 call s_populate_riemann_states_variables_buffers( &
767 ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
768 dql_prim_dy_vf, &
769 dql_prim_dz_vf, &
770 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
771 dqr_prim_dy_vf, &
772 dqr_prim_dz_vf, &
773 norm_dir, ix, iy, iz)
774
775 ! Reshaping inputted data based on dimensional splitting direction
776 call s_initialize_riemann_solver( &
777 flux_src_vf, &
778 norm_dir)
779# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
780
781 if (norm_dir == 1) then
782
783# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
784
785# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
786#if defined(MFC_OpenACC)
787# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
788!$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)
789# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
790#elif defined(MFC_OpenMP)
791# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
792
793# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
794
795# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
796
797# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
798!$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)
799# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
800#endif
801# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
802
803 do l = is3%beg, is3%end
804 do k = is2%beg, is2%end
805 do j = is1%beg, is1%end
806
807# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
808#if defined(MFC_OpenACC)
809# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
810!$acc loop seq
811# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
812#elif defined(MFC_OpenMP)
813# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
814
815# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
816#endif
817 do i = 1, contxe
818 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
819 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
820 end do
821
822 vel_l_rms = 0._wp; vel_r_rms = 0._wp
823
824
825# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
826#if defined(MFC_OpenACC)
827# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
828!$acc loop seq
829# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
830#elif defined(MFC_OpenMP)
831# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
832
833# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
834#endif
835 do i = 1, num_vels
836 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
837 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
838 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
839 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
840 end do
841
842
843# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
844#if defined(MFC_OpenACC)
845# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
846!$acc loop seq
847# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
848#elif defined(MFC_OpenMP)
849# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
850
851# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
852#endif
853 do i = 1, num_fluids
854 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
855 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
856 end do
857
858 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
859 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
860
861 if (mhd) then
862 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
863 b%L(1) = bx0
864 b%R(1) = bx0
865 b%L(2) = ql_prim_rsx_vf(j, k, l, b_idx%beg)
866 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg)
867 b%L(3) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)
868 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 1)
869 else ! 2D/3D: Bx, By, Bz as variables
870 b%L(1) = ql_prim_rsx_vf(j, k, l, b_idx%beg)
871 b%R(1) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg)
872 b%L(2) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)
873 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 1)
874 b%L(3) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 2)
875 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 2)
876 end if
877 end if
878
879 rho_l = 0._wp
880 gamma_l = 0._wp
881 pi_inf_l = 0._wp
882 qv_l = 0._wp
883
884 rho_r = 0._wp
885 gamma_r = 0._wp
886 pi_inf_r = 0._wp
887 qv_r = 0._wp
888
889 alpha_l_sum = 0._wp
890 alpha_r_sum = 0._wp
891
892 pres_mag%L = 0._wp
893 pres_mag%R = 0._wp
894
895 if (mpp_lim) then
896
897# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
898#if defined(MFC_OpenACC)
899# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
900!$acc loop seq
901# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
902#elif defined(MFC_OpenMP)
903# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
904
905# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
906#endif
907 do i = 1, num_fluids
908 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
909 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
910 alpha_l_sum = alpha_l_sum + alpha_l(i)
911 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
912 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
913 alpha_r_sum = alpha_r_sum + alpha_r(i)
914 end do
915
916 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
917 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
918 end if
919
920
921# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
922#if defined(MFC_OpenACC)
923# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
924!$acc loop seq
925# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
926#elif defined(MFC_OpenMP)
927# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
928
929# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
930#endif
931 do i = 1, num_fluids
932 rho_l = rho_l + alpha_rho_l(i)
933 gamma_l = gamma_l + alpha_l(i)*gammas(i)
934 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
935 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
936
937 rho_r = rho_r + alpha_rho_r(i)
938 gamma_r = gamma_r + alpha_r(i)*gammas(i)
939 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
940 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
941 end do
942
943 if (viscous) then
944
945# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
946#if defined(MFC_OpenACC)
947# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
948!$acc loop seq
949# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
950#elif defined(MFC_OpenMP)
951# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
952
953# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
954#endif
955 do i = 1, 2
956 re_l(i) = dflt_real
957 re_r(i) = dflt_real
958
959 if (re_size(i) > 0) re_l(i) = 0._wp
960 if (re_size(i) > 0) re_r(i) = 0._wp
961
962
963# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
964#if defined(MFC_OpenACC)
965# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
966!$acc loop seq
967# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
968#elif defined(MFC_OpenMP)
969# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
970
971# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
972#endif
973 do q = 1, re_size(i)
974 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
975 + re_l(i)
976 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
977 + re_r(i)
978 end do
979
980 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
981 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
982 end do
983 end if
984
985 if (chemistry) then
986
987# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
988#if defined(MFC_OpenACC)
989# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
990!$acc loop seq
991# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
992#elif defined(MFC_OpenMP)
993# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
994
995# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
996#endif
997 do i = chemxb, chemxe
998 ys_l(i - chemxb + 1) = ql_prim_rsx_vf(j, k, l, i)
999 ys_r(i - chemxb + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
1000 end do
1001
1002 call get_mixture_molecular_weight(ys_l, mw_l)
1003 call get_mixture_molecular_weight(ys_r, mw_r)
1004# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1005 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
1006 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
1007# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1008
1009 r_gas_l = gas_constant/mw_l
1010 r_gas_r = gas_constant/mw_r
1011 t_l = pres_l/rho_l/r_gas_l
1012 t_r = pres_r/rho_r/r_gas_r
1013
1014 call get_species_specific_heats_r(t_l, cp_il)
1015 call get_species_specific_heats_r(t_r, cp_ir)
1016
1017 if (chem_params%gamma_method == 1) then
1018 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
1019 gamma_il = cp_il/(cp_il - 1.0_wp)
1020 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
1021
1022 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
1023 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
1024 else if (chem_params%gamma_method == 2) then
1025 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
1026 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
1027 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
1028 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
1029 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
1030
1031 gamm_l = cp_l/cv_l
1032 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
1033 gamm_r = cp_r/cv_r
1034 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
1035 end if
1036
1037 call get_mixture_energy_mass(t_l, ys_l, e_l)
1038 call get_mixture_energy_mass(t_r, ys_r, e_r)
1039
1040 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
1041 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
1042 h_l = (e_l + pres_l)/rho_l
1043 h_r = (e_r + pres_r)/rho_r
1044 elseif (mhd .and. relativity) then
1045 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
1046 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
1047# 533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1048 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
1049 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
1050
1051 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
1052 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
1053 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
1054 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
1055# 541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1056
1057 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
1058 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
1059
1060 ! Hard-coded EOS
1061 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
1062 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
1063# 549 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1064 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
1065 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
1066# 552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1067
1068 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
1069 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
1070 elseif (mhd .and. .not. relativity) then
1071# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1072 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
1073 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
1074# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1075 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
1076 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R ! includes magnetic energy
1077 h_l = (e_l + pres_l - pres_mag%L)/rho_l
1078 h_r = (e_r + pres_r - pres_mag%R)/rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
1079 else
1080 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
1081 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
1082 h_l = (e_l + pres_l)/rho_l
1083 h_r = (e_r + pres_r)/rho_r
1084 end if
1085
1086 ! elastic energy update
1087 if (hypoelasticity) then
1088 g_l = 0._wp; g_r = 0._wp
1089
1090
1091# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1092#if defined(MFC_OpenACC)
1093# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1094!$acc loop seq
1095# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1096#elif defined(MFC_OpenMP)
1097# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1098
1099# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1100#endif
1101 do i = 1, num_fluids
1102 g_l = g_l + alpha_l(i)*gs_rs(i)
1103 g_r = g_r + alpha_r(i)*gs_rs(i)
1104 end do
1105
1106 if (cont_damage) then
1107 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, damage_idx)), 0._wp)
1108 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, damage_idx)), 0._wp)
1109 end if
1110
1111
1112# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1113#if defined(MFC_OpenACC)
1114# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1115!$acc loop seq
1116# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1117#elif defined(MFC_OpenMP)
1118# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1119
1120# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1121#endif
1122 do i = 1, strxe - strxb + 1
1123 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
1124 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
1125 ! Elastic contribution to energy if G large enough
1126 !TODO take out if statement if stable without
1127 if ((g_l > 1000) .and. (g_r > 1000)) then
1128 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
1129 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
1130 ! Double for shear stresses
1131 if (any(strxb - 1 + i == shear_indices)) then
1132 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
1133 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
1134 end if
1135 end if
1136 end do
1137 end if
1138
1139 ! elastic energy update
1140 !if ( hyperelasticity ) then
1141 ! G_L = 0._wp
1142 ! G_R = 0._wp
1143 !
1144 ! $:GPU_LOOP(parallelism='[seq]')
1145 ! do i = 1, num_fluids
1146 ! G_L = G_L + alpha_L(i)*Gs_rs(i)
1147 ! G_R = G_R + alpha_R(i)*Gs_rs(i)
1148 ! end do
1149 ! ! Elastic contribution to energy if G large enough
1150 ! if ((G_L > 1.e-3_wp) .and. (G_R > 1.e-3_wp)) then
1151 ! E_L = E_L + G_L*qL_prim_rsx_vf(j, k, l, xiend + 1)
1152 ! E_R = E_R + G_R*qR_prim_rsx_vf(j + 1, k, l, xiend + 1)
1153 ! $:GPU_LOOP(parallelism='[seq]')
1154 ! do i = 1, b_size-1
1155 ! tau_e_L(i) = G_L*qL_prim_rsx_vf(j, k, l, strxb - 1 + i)
1156 ! tau_e_R(i) = G_R*qR_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
1157 ! end do
1158 ! $:GPU_LOOP(parallelism='[seq]')
1159 ! do i = 1, b_size-1
1160 ! tau_e_L(i) = 0._wp
1161 ! tau_e_R(i) = 0._wp
1162 ! end do
1163 ! $:GPU_LOOP(parallelism='[seq]')
1164 ! do i = 1, num_dims
1165 ! xi_field_L(i) = qL_prim_rsx_vf(j, k, l, xibeg - 1 + i)
1166 ! xi_field_R(i) = qR_prim_rsx_vf(j + 1, k, l, xibeg - 1 + i)
1167 ! end do
1168 ! end if
1169 !end if
1170
1171
1172# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1173 if (avg_state == 1) then
1174# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1175
1176# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1177 rho_avg = sqrt(rho_l*rho_r)
1178# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1179
1180# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1181 vel_avg_rms = 0._wp
1182# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1183
1184# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1185
1186# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1187#if defined(MFC_OpenACC)
1188# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1189!$acc loop seq
1190# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1191#elif defined(MFC_OpenMP)
1192# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1193
1194# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1195#endif
1196# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1197 do i = 1, num_vels
1198# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1199 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
1200# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1201 (sqrt(rho_l) + sqrt(rho_r))**2._wp
1202# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1203 end do
1204# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1205
1206# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1207 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
1208# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1209 (sqrt(rho_l) + sqrt(rho_r))
1210# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1211
1212# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1213 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
1214# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1215 (sqrt(rho_l) + sqrt(rho_r))
1216# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1217
1218# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1219 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
1220# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1221 (sqrt(rho_l) + sqrt(rho_r))**2._wp
1222# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1223
1224# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1225 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
1226# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1227 (sqrt(rho_l) + sqrt(rho_r))
1228# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1229
1230# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1231 if (chemistry) then
1232# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1233 eps = 0.001_wp
1234# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1235 call get_species_enthalpies_rt(t_l, h_il)
1236# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1237 call get_species_enthalpies_rt(t_r, h_ir)
1238# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1239 h_il = h_il*gas_constant/molecular_weights*t_l
1240# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1241 h_ir = h_ir*gas_constant/molecular_weights*t_r
1242# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1243 call get_species_specific_heats_r(t_l, cp_il)
1244# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1245 call get_species_specific_heats_r(t_r, cp_ir)
1246# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1247
1248# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1249 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
1250# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1251 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
1252# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1253 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
1254# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1255 if (abs(t_l - t_r) < eps) then
1256# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1257 ! Case when T_L and T_R are very close
1258# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1259 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
1260# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1261 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
1262# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1263 else
1264# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1265 ! Normal calculation when T_L and T_R are sufficiently different
1266# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1267 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
1268# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1269 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
1270# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1271 end if
1272# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1273 gamma_avg = cp_avg/cv_avg
1274# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1275
1276# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1277 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
1278# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1279 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
1280# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1281
1282# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1283 end if
1284# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1285
1286# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1287 end if
1288# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1289
1290# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1291 if (avg_state == 2) then
1292# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1293 rho_avg = 5.e-1_wp*(rho_l + rho_r)
1294# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1295 vel_avg_rms = 0._wp
1296# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1297
1298# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1299#if defined(MFC_OpenACC)
1300# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1301!$acc loop seq
1302# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1303#elif defined(MFC_OpenMP)
1304# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1305
1306# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1307#endif
1308# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1309 do i = 1, num_vels
1310# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1311 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
1312# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1313 end do
1314# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1315
1316# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1317 h_avg = 5.e-1_wp*(h_l + h_r)
1318# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1319 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
1320# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1321 qv_avg = 5.e-1_wp*(qv_l + qv_r)
1322# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1323
1324# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1325 end if
1326# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1327
1328
1329 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
1330 vel_l_rms, 0._wp, c_l, qv_l)
1331
1332 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
1333 vel_r_rms, 0._wp, c_r, qv_r)
1334
1335 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
1336 ! variables are placeholders to call the subroutine.
1337
1338 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
1339 vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
1340
1341 if (mhd) then
1342 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
1343 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
1344 end if
1345
1346 if (hyper_cleaning) then ! mhd
1347 c_fast%L = min(c_fast%L, -hyper_cleaning_speed)
1348 c_fast%R = max(c_fast%R, hyper_cleaning_speed)
1349 end if
1350
1351 if (viscous) then
1352 if (chemistry) then
1353 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
1354 end if
1355
1356# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1357#if defined(MFC_OpenACC)
1358# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1359!$acc loop seq
1360# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1361#elif defined(MFC_OpenMP)
1362# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1363
1364# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1365#endif
1366 do i = 1, 2
1367 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
1368 end do
1369 end if
1370
1371 if (wave_speeds == 1) then
1372 if (mhd) then
1373 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
1374 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
1375 elseif (hypoelasticity) then
1376 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
1377 (((4._wp*g_l)/3._wp) + &
1378 tau_e_l(dir_idx_tau(1)))/rho_l) &
1379 , vel_r(dir_idx(1)) - sqrt(c_r*c_r + &
1380 (((4._wp*g_r)/3._wp) + &
1381 tau_e_r(dir_idx_tau(1)))/rho_r))
1382 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
1383 (((4._wp*g_r)/3._wp) + &
1384 tau_e_r(dir_idx_tau(1)))/rho_r) &
1385 , vel_l(dir_idx(1)) + sqrt(c_l*c_l + &
1386 (((4._wp*g_l)/3._wp) + &
1387 tau_e_l(dir_idx_tau(1)))/rho_l))
1388 else if (hyperelasticity) then
1389 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l) &
1390 , vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
1391 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r) &
1392 , vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
1393 else
1394 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
1395 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
1396 end if
1397
1398 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
1399 (s_l - vel_l(dir_idx(1))) - &
1400 rho_r*vel_r(dir_idx(1))* &
1401 (s_r - vel_r(dir_idx(1)))) &
1402 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
1403 rho_r*(s_r - vel_r(dir_idx(1))))
1404 elseif (wave_speeds == 2) then
1405 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
1406 (vel_l(dir_idx(1)) - &
1407 vel_r(dir_idx(1))))
1408
1409 pres_sr = pres_sl
1410
1411 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
1412 (pres_sl/pres_l - 1._wp)*pres_l/ &
1413 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
1414 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
1415 (pres_sr/pres_r - 1._wp)*pres_r/ &
1416 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
1417
1418 s_l = vel_l(dir_idx(1)) - c_l*ms_l
1419 s_r = vel_r(dir_idx(1)) + c_r*ms_r
1420
1421 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
1422 (pres_l - pres_r)/ &
1423 (rho_avg*c_avg))
1424 end if
1425
1426 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
1427
1428 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_l)) &
1429 + (5.e-1_wp - sign(5.e-1_wp, s_l)) &
1430 *(5.e-1_wp + sign(5.e-1_wp, s_r))
1431 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_r)) &
1432 + (5.e-1_wp - sign(5.e-1_wp, s_l)) &
1433 *(5.e-1_wp + sign(5.e-1_wp, s_r))
1434
1435 ! Low Mach correction
1436 if (low_mach == 1) then
1437
1438# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1439 if (riemann_solver == 1 .or. riemann_solver == 5) then
1440# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1441
1442# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1443 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1444# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1445 pcorr = 0._wp
1446# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1447
1448# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1449 if (low_mach == 1) then
1450# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1451 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
1452# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1453 end if
1454# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1455
1456# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1457 else if (riemann_solver == 2) then
1458# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1459 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
1460# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1461 pcorr = 0._wp
1462# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1463
1464# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1465 if (low_mach == 1) then
1466# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1467 pcorr = rho_l*rho_r* &
1468# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1469 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
1470# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1471 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
1472# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1473 (zcoef - 1._wp)
1474# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1475 else if (low_mach == 2) then
1476# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1477 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))))
1478# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1479 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))))
1480# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1481 vel_l(dir_idx(1)) = vel_l_tmp
1482# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1483 vel_r(dir_idx(1)) = vel_r_tmp
1484# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1485 end if
1486# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1487 end if
1488# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1489
1490 else
1491 pcorr = 0._wp
1492 end if
1493
1494 ! Mass
1495 if (.not. relativity) then
1496
1497# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1498#if defined(MFC_OpenACC)
1499# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1500!$acc loop seq
1501# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1502#elif defined(MFC_OpenMP)
1503# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1504
1505# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1506#endif
1507 do i = 1, contxe
1508 flux_rsx_vf(j, k, l, i) = &
1509 (s_m*alpha_rho_r(i)*vel_r(norm_dir) &
1510 - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
1511 + s_m*s_p*(alpha_rho_l(i) &
1512 - alpha_rho_r(i))) &
1513 /(s_m - s_p)
1514 end do
1515 elseif (relativity) then
1516
1517# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1518#if defined(MFC_OpenACC)
1519# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1520!$acc loop seq
1521# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1522#elif defined(MFC_OpenMP)
1523# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1524
1525# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1526#endif
1527 do i = 1, contxe
1528 flux_rsx_vf(j, k, l, i) = &
1529 (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) &
1530 - s_p*ga%L*alpha_rho_l(i)*vel_l(norm_dir) &
1531 + s_m*s_p*(ga%L*alpha_rho_l(i) &
1532 - ga%R*alpha_rho_r(i))) &
1533 /(s_m - s_p)
1534 end do
1535 end if
1536
1537 ! Momentum
1538 if (mhd .and. (.not. relativity)) then
1539
1540# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1541#if defined(MFC_OpenACC)
1542# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1543!$acc loop seq
1544# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1545#elif defined(MFC_OpenMP)
1546# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1547
1548# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1549#endif
1550 do i = 1, 3
1551 ! Flux of rho*v_i in the x direction
1552 ! = rho * v_i * v_x - B_i * B_x + delta_(x,i) * p_tot
1553 flux_rsx_vf(j, k, l, contxe + i) = &
1554 (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) &
1555 - b%R(i)*b%R(norm_dir) &
1556 + dir_flg(i)*(pres_r + pres_mag%R)) &
1557 - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
1558 - b%L(i)*b%L(norm_dir) &
1559 + dir_flg(i)*(pres_l + pres_mag%L)) &
1560 + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i))) &
1561 /(s_m - s_p)
1562 end do
1563 elseif (mhd .and. relativity) then
1564
1565# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1566#if defined(MFC_OpenACC)
1567# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1568!$acc loop seq
1569# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1570#elif defined(MFC_OpenMP)
1571# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1572
1573# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1574#endif
1575 do i = 1, 3
1576 ! Flux of m_i in the x direction
1577 ! = m_i * v_x - b_i/Gamma * B_x + delta_(x,i) * p_tot
1578 flux_rsx_vf(j, k, l, contxe + i) = &
1579 (s_m*(cm%R(i)*vel_r(norm_dir) &
1580 - b4%R(i)/ga%R*b%R(norm_dir) &
1581 + dir_flg(i)*(pres_r + pres_mag%R)) &
1582 - s_p*(cm%L(i)*vel_l(norm_dir) &
1583 - b4%L(i)/ga%L*b%L(norm_dir) &
1584 + dir_flg(i)*(pres_l + pres_mag%L)) &
1585 + s_m*s_p*(cm%L(i) - cm%R(i))) &
1586 /(s_m - s_p)
1587 end do
1588 elseif (bubbles_euler) then
1589
1590# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1591#if defined(MFC_OpenACC)
1592# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1593!$acc loop seq
1594# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1595#elif defined(MFC_OpenMP)
1596# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1597
1598# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1599#endif
1600 do i = 1, num_vels
1601 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
1602 (s_m*(rho_r*vel_r(dir_idx(1)) &
1603 *vel_r(dir_idx(i)) &
1604 + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
1605 - s_p*(rho_l*vel_l(dir_idx(1)) &
1606 *vel_l(dir_idx(i)) &
1607 + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
1608 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
1609 - rho_r*vel_r(dir_idx(i)))) &
1610 /(s_m - s_p) &
1611 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
1612 end do
1613 else if (hypoelasticity) then
1614
1615# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1616#if defined(MFC_OpenACC)
1617# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1618!$acc loop seq
1619# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1620#elif defined(MFC_OpenMP)
1621# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1622
1623# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1624#endif
1625 do i = 1, num_vels
1626 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
1627 (s_m*(rho_r*vel_r(dir_idx(1)) &
1628 *vel_r(dir_idx(i)) &
1629 + dir_flg(dir_idx(i))*pres_r &
1630 - tau_e_r(dir_idx_tau(i))) &
1631 - s_p*(rho_l*vel_l(dir_idx(1)) &
1632 *vel_l(dir_idx(i)) &
1633 + dir_flg(dir_idx(i))*pres_l &
1634 - tau_e_l(dir_idx_tau(i))) &
1635 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
1636 - rho_r*vel_r(dir_idx(i)))) &
1637 /(s_m - s_p)
1638 end do
1639 else
1640
1641# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1642#if defined(MFC_OpenACC)
1643# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1644!$acc loop seq
1645# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1646#elif defined(MFC_OpenMP)
1647# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1648
1649# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1650#endif
1651 do i = 1, num_vels
1652 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
1653 (s_m*(rho_r*vel_r(dir_idx(1)) &
1654 *vel_r(dir_idx(i)) &
1655 + dir_flg(dir_idx(i))*pres_r) &
1656 - s_p*(rho_l*vel_l(dir_idx(1)) &
1657 *vel_l(dir_idx(i)) &
1658 + dir_flg(dir_idx(i))*pres_l) &
1659 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
1660 - rho_r*vel_r(dir_idx(i)))) &
1661 /(s_m - s_p) &
1662 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
1663 end do
1664 end if
1665
1666 ! Energy
1667 if (mhd .and. (.not. relativity)) then
1668 ! energy flux = (E + p + p_mag) * v_x - B_x * (v_x*B_x + v_y*B_y + v_z*B_z)
1669# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1670 flux_rsx_vf(j, k, l, e_idx) = &
1671 (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir)*(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
1672 - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) &
1673 + s_m*s_p*(e_l - e_r)) &
1674 /(s_m - s_p)
1675# 853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1676 elseif (mhd .and. relativity) then
1677 ! energy flux = m_x - mass flux
1678 ! Hard-coded for single-component for now
1679 flux_rsx_vf(j, k, l, e_idx) = &
1680 (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
1681 - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) &
1682 + s_m*s_p*(e_l - e_r)) &
1683 /(s_m - s_p)
1684 else if (bubbles_euler) then
1685 flux_rsx_vf(j, k, l, e_idx) = &
1686 (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
1687 - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) &
1688 + s_m*s_p*(e_l - e_r)) &
1689 /(s_m - s_p) &
1690 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
1691 else if (hypoelasticity) then
1692 flux_tau_l = 0._wp; flux_tau_r = 0._wp
1693
1694# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1695#if defined(MFC_OpenACC)
1696# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1697!$acc loop seq
1698# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1699#elif defined(MFC_OpenMP)
1700# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1701
1702# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1703#endif
1704 do i = 1, num_dims
1705 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
1706 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
1707 end do
1708 flux_rsx_vf(j, k, l, e_idx) = &
1709 (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
1710 - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) &
1711 + s_m*s_p*(e_l - e_r))/(s_m - s_p)
1712 else
1713 flux_rsx_vf(j, k, l, e_idx) = &
1714 (s_m*vel_r(dir_idx(1))*(e_r + pres_r) &
1715 - s_p*vel_l(dir_idx(1))*(e_l + pres_l) &
1716 + s_m*s_p*(e_l - e_r)) &
1717 /(s_m - s_p) &
1718 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
1719 end if
1720
1721 ! Elastic Stresses
1722 if (hypoelasticity) then
1723 do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow
1724 flux_rsx_vf(j, k, l, strxb - 1 + i) = &
1725 (s_m*(rho_r*vel_r(dir_idx(1)) &
1726 *tau_e_r(i)) &
1727 - s_p*(rho_l*vel_l(dir_idx(1)) &
1728 *tau_e_l(i)) &
1729 + s_m*s_p*(rho_l*tau_e_l(i) &
1730 - rho_r*tau_e_r(i))) &
1731 /(s_m - s_p)
1732 end do
1733 end if
1734
1735 ! Advection
1736
1737# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1738#if defined(MFC_OpenACC)
1739# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1740!$acc loop seq
1741# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1742#elif defined(MFC_OpenMP)
1743# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1744
1745# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1746#endif
1747 do i = advxb, advxe
1748 flux_rsx_vf(j, k, l, i) = &
1749 (ql_prim_rsx_vf(j, k, l, i) &
1750 - qr_prim_rsx_vf(j + 1, k, l, i)) &
1751 *s_m*s_p/(s_m - s_p)
1752 flux_src_rsx_vf(j, k, l, i) = &
1753 (s_m*qr_prim_rsx_vf(j + 1, k, l, i) &
1754 - s_p*ql_prim_rsx_vf(j, k, l, i)) &
1755 /(s_m - s_p)
1756 end do
1757
1758 if (bubbles_euler) then
1759 ! From HLLC: Kills mass transport @ bubble gas density
1760 if (num_fluids > 1) then
1761 flux_rsx_vf(j, k, l, contxe) = 0._wp
1762 end if
1763 end if
1764
1765 if (chemistry) then
1766
1767# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1768#if defined(MFC_OpenACC)
1769# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1770!$acc loop seq
1771# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1772#elif defined(MFC_OpenMP)
1773# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1774
1775# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1776#endif
1777 do i = chemxb, chemxe
1778 y_l = ql_prim_rsx_vf(j, k, l, i)
1779 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
1780
1781 flux_rsx_vf(j, k, l, i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) &
1782 - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
1783 + s_m*s_p*(y_l*rho_l - y_r*rho_r)) &
1784 /(s_m - s_p)
1785 flux_src_rsx_vf(j, k, l, i) = 0._wp
1786 end do
1787 end if
1788
1789 if (mhd) then
1790 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
1791 ! B_y flux = v_x * B_y - v_y * Bx0
1792 ! B_z flux = v_x * B_z - v_z * Bx0
1793
1794# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1795#if defined(MFC_OpenACC)
1796# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1797!$acc loop seq
1798# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1799#elif defined(MFC_OpenMP)
1800# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1801
1802# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1803#endif
1804 do i = 0, 1
1805 flux_rsx_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
1806 - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) &
1807 + s_m*s_p*(b%L(2 + i) - b%R(2 + i)))/(s_m - s_p)
1808 end do
1809 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
1810 ! B_x d/dx flux = (1 - delta(x,x)) * (v_x * B_x - v_x * B_x)
1811 ! B_y d/dx flux = (1 - delta(y,x)) * (v_x * B_y - v_y * B_x)
1812 ! B_z d/dx flux = (1 - delta(z,x)) * (v_x * B_z - v_z * B_x)
1813
1814# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1815#if defined(MFC_OpenACC)
1816# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1817!$acc loop seq
1818# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1819#elif defined(MFC_OpenMP)
1820# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1821
1822# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1823#endif
1824 do i = 0, 2
1825 flux_rsx_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1)*b%R(norm_dir)) - &
1826 s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + &
1827 s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
1828 end do
1829
1830 if (hyper_cleaning) then
1831 ! propagate magnetic field divergence as a wave
1832 flux_rsx_vf(j, k, l, b_idx%beg + norm_dir - 1) = flux_rsx_vf(j, k, l, b_idx%beg + norm_dir - 1) + &
1833 (s_m*qr_prim_rsx_vf(j + 1, k, l, psi_idx) - s_p*ql_prim_rsx_vf(j, k, l, psi_idx))/(s_m - s_p)
1834
1835 flux_rsx_vf(j, k, l, psi_idx) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsx_vf(j, k, l, psi_idx) - qr_prim_rsx_vf(j + 1, k, l, psi_idx)))/(s_m - s_p)
1836 else
1837 flux_rsx_vf(j, k, l, b_idx%beg + norm_dir - 1) = 0._wp ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
1838 end if
1839 end if
1840 flux_src_rsx_vf(j, k, l, advxb) = 0._wp
1841 end if
1842
1843# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1844
1845 end do
1846 end do
1847 end do
1848
1849# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1850
1851# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1852#if defined(MFC_OpenACC)
1853# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1854!$acc end parallel loop
1855# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1856#elif defined(MFC_OpenMP)
1857# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1858
1859# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1860
1861# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1862!$omp end target teams loop
1863# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1864#endif
1865# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1866
1867 end if
1868
1869# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1870
1871 if (norm_dir == 2) then
1872
1873# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1874
1875# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1876#if defined(MFC_OpenACC)
1877# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1878!$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)
1879# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1880#elif defined(MFC_OpenMP)
1881# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1882
1883# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1884
1885# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1886
1887# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1888!$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)
1889# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1890#endif
1891# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1892
1893 do l = is3%beg, is3%end
1894 do k = is2%beg, is2%end
1895 do j = is1%beg, is1%end
1896
1897# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1898#if defined(MFC_OpenACC)
1899# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1900!$acc loop seq
1901# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1902#elif defined(MFC_OpenMP)
1903# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1904
1905# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1906#endif
1907 do i = 1, contxe
1908 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
1909 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
1910 end do
1911
1912 vel_l_rms = 0._wp; vel_r_rms = 0._wp
1913
1914
1915# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1916#if defined(MFC_OpenACC)
1917# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1918!$acc loop seq
1919# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1920#elif defined(MFC_OpenMP)
1921# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1922
1923# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1924#endif
1925 do i = 1, num_vels
1926 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
1927 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
1928 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
1929 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
1930 end do
1931
1932
1933# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1934#if defined(MFC_OpenACC)
1935# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1936!$acc loop seq
1937# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1938#elif defined(MFC_OpenMP)
1939# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1940
1941# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1942#endif
1943 do i = 1, num_fluids
1944 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
1945 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
1946 end do
1947
1948 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
1949 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
1950
1951 if (mhd) then
1952 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
1953 b%L(1) = bx0
1954 b%R(1) = bx0
1955 b%L(2) = ql_prim_rsy_vf(j, k, l, b_idx%beg)
1956 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg)
1957 b%L(3) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)
1958 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 1)
1959 else ! 2D/3D: Bx, By, Bz as variables
1960 b%L(1) = ql_prim_rsy_vf(j, k, l, b_idx%beg)
1961 b%R(1) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg)
1962 b%L(2) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)
1963 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 1)
1964 b%L(3) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 2)
1965 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 2)
1966 end if
1967 end if
1968
1969 rho_l = 0._wp
1970 gamma_l = 0._wp
1971 pi_inf_l = 0._wp
1972 qv_l = 0._wp
1973
1974 rho_r = 0._wp
1975 gamma_r = 0._wp
1976 pi_inf_r = 0._wp
1977 qv_r = 0._wp
1978
1979 alpha_l_sum = 0._wp
1980 alpha_r_sum = 0._wp
1981
1982 pres_mag%L = 0._wp
1983 pres_mag%R = 0._wp
1984
1985 if (mpp_lim) then
1986
1987# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1988#if defined(MFC_OpenACC)
1989# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1990!$acc loop seq
1991# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1992#elif defined(MFC_OpenMP)
1993# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1994
1995# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
1996#endif
1997 do i = 1, num_fluids
1998 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
1999 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
2000 alpha_l_sum = alpha_l_sum + alpha_l(i)
2001 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
2002 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
2003 alpha_r_sum = alpha_r_sum + alpha_r(i)
2004 end do
2005
2006 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
2007 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
2008 end if
2009
2010
2011# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2012#if defined(MFC_OpenACC)
2013# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2014!$acc loop seq
2015# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2016#elif defined(MFC_OpenMP)
2017# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2018
2019# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2020#endif
2021 do i = 1, num_fluids
2022 rho_l = rho_l + alpha_rho_l(i)
2023 gamma_l = gamma_l + alpha_l(i)*gammas(i)
2024 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
2025 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
2026
2027 rho_r = rho_r + alpha_rho_r(i)
2028 gamma_r = gamma_r + alpha_r(i)*gammas(i)
2029 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
2030 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
2031 end do
2032
2033 if (viscous) then
2034
2035# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2036#if defined(MFC_OpenACC)
2037# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2038!$acc loop seq
2039# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2040#elif defined(MFC_OpenMP)
2041# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2042
2043# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2044#endif
2045 do i = 1, 2
2046 re_l(i) = dflt_real
2047 re_r(i) = dflt_real
2048
2049 if (re_size(i) > 0) re_l(i) = 0._wp
2050 if (re_size(i) > 0) re_r(i) = 0._wp
2051
2052
2053# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2054#if defined(MFC_OpenACC)
2055# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2056!$acc loop seq
2057# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2058#elif defined(MFC_OpenMP)
2059# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2060
2061# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2062#endif
2063 do q = 1, re_size(i)
2064 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
2065 + re_l(i)
2066 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
2067 + re_r(i)
2068 end do
2069
2070 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
2071 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
2072 end do
2073 end if
2074
2075 if (chemistry) then
2076
2077# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2078#if defined(MFC_OpenACC)
2079# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2080!$acc loop seq
2081# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2082#elif defined(MFC_OpenMP)
2083# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2084
2085# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2086#endif
2087 do i = chemxb, chemxe
2088 ys_l(i - chemxb + 1) = ql_prim_rsy_vf(j, k, l, i)
2089 ys_r(i - chemxb + 1) = qr_prim_rsy_vf(j + 1, k, l, i)
2090 end do
2091
2092 call get_mixture_molecular_weight(ys_l, mw_l)
2093 call get_mixture_molecular_weight(ys_r, mw_r)
2094# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2095 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
2096 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
2097# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2098
2099 r_gas_l = gas_constant/mw_l
2100 r_gas_r = gas_constant/mw_r
2101 t_l = pres_l/rho_l/r_gas_l
2102 t_r = pres_r/rho_r/r_gas_r
2103
2104 call get_species_specific_heats_r(t_l, cp_il)
2105 call get_species_specific_heats_r(t_r, cp_ir)
2106
2107 if (chem_params%gamma_method == 1) then
2108 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
2109 gamma_il = cp_il/(cp_il - 1.0_wp)
2110 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
2111
2112 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
2113 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
2114 else if (chem_params%gamma_method == 2) then
2115 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
2116 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
2117 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
2118 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
2119 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
2120
2121 gamm_l = cp_l/cv_l
2122 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
2123 gamm_r = cp_r/cv_r
2124 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
2125 end if
2126
2127 call get_mixture_energy_mass(t_l, ys_l, e_l)
2128 call get_mixture_energy_mass(t_r, ys_r, e_r)
2129
2130 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
2131 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
2132 h_l = (e_l + pres_l)/rho_l
2133 h_r = (e_r + pres_r)/rho_r
2134 elseif (mhd .and. relativity) then
2135 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
2136 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
2137# 533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2138 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
2139 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
2140
2141 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
2142 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
2143 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
2144 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
2145# 541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2146
2147 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
2148 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
2149
2150 ! Hard-coded EOS
2151 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
2152 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
2153# 549 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2154 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
2155 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
2156# 552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2157
2158 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
2159 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
2160 elseif (mhd .and. .not. relativity) then
2161# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2162 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
2163 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
2164# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2165 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
2166 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R ! includes magnetic energy
2167 h_l = (e_l + pres_l - pres_mag%L)/rho_l
2168 h_r = (e_r + pres_r - pres_mag%R)/rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
2169 else
2170 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
2171 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
2172 h_l = (e_l + pres_l)/rho_l
2173 h_r = (e_r + pres_r)/rho_r
2174 end if
2175
2176 ! elastic energy update
2177 if (hypoelasticity) then
2178 g_l = 0._wp; g_r = 0._wp
2179
2180
2181# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2182#if defined(MFC_OpenACC)
2183# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2184!$acc loop seq
2185# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2186#elif defined(MFC_OpenMP)
2187# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2188
2189# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2190#endif
2191 do i = 1, num_fluids
2192 g_l = g_l + alpha_l(i)*gs_rs(i)
2193 g_r = g_r + alpha_r(i)*gs_rs(i)
2194 end do
2195
2196 if (cont_damage) then
2197 g_l = g_l*max((1._wp - ql_prim_rsy_vf(j, k, l, damage_idx)), 0._wp)
2198 g_r = g_r*max((1._wp - qr_prim_rsy_vf(j, k, l, damage_idx)), 0._wp)
2199 end if
2200
2201
2202# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2203#if defined(MFC_OpenACC)
2204# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2205!$acc loop seq
2206# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2207#elif defined(MFC_OpenMP)
2208# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2209
2210# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2211#endif
2212 do i = 1, strxe - strxb + 1
2213 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
2214 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
2215 ! Elastic contribution to energy if G large enough
2216 !TODO take out if statement if stable without
2217 if ((g_l > 1000) .and. (g_r > 1000)) then
2218 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2219 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2220 ! Double for shear stresses
2221 if (any(strxb - 1 + i == shear_indices)) then
2222 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
2223 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
2224 end if
2225 end if
2226 end do
2227 end if
2228
2229 ! elastic energy update
2230 !if ( hyperelasticity ) then
2231 ! G_L = 0._wp
2232 ! G_R = 0._wp
2233 !
2234 ! $:GPU_LOOP(parallelism='[seq]')
2235 ! do i = 1, num_fluids
2236 ! G_L = G_L + alpha_L(i)*Gs_rs(i)
2237 ! G_R = G_R + alpha_R(i)*Gs_rs(i)
2238 ! end do
2239 ! ! Elastic contribution to energy if G large enough
2240 ! if ((G_L > 1.e-3_wp) .and. (G_R > 1.e-3_wp)) then
2241 ! E_L = E_L + G_L*qL_prim_rsy_vf(j, k, l, xiend + 1)
2242 ! E_R = E_R + G_R*qR_prim_rsy_vf(j + 1, k, l, xiend + 1)
2243 ! $:GPU_LOOP(parallelism='[seq]')
2244 ! do i = 1, b_size-1
2245 ! tau_e_L(i) = G_L*qL_prim_rsy_vf(j, k, l, strxb - 1 + i)
2246 ! tau_e_R(i) = G_R*qR_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
2247 ! end do
2248 ! $:GPU_LOOP(parallelism='[seq]')
2249 ! do i = 1, b_size-1
2250 ! tau_e_L(i) = 0._wp
2251 ! tau_e_R(i) = 0._wp
2252 ! end do
2253 ! $:GPU_LOOP(parallelism='[seq]')
2254 ! do i = 1, num_dims
2255 ! xi_field_L(i) = qL_prim_rsy_vf(j, k, l, xibeg - 1 + i)
2256 ! xi_field_R(i) = qR_prim_rsy_vf(j + 1, k, l, xibeg - 1 + i)
2257 ! end do
2258 ! end if
2259 !end if
2260
2261
2262# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2263 if (avg_state == 1) then
2264# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2265
2266# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2267 rho_avg = sqrt(rho_l*rho_r)
2268# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2269
2270# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2271 vel_avg_rms = 0._wp
2272# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2273
2274# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2275
2276# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2277#if defined(MFC_OpenACC)
2278# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2279!$acc loop seq
2280# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2281#elif defined(MFC_OpenMP)
2282# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2283
2284# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2285#endif
2286# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2287 do i = 1, num_vels
2288# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2289 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
2290# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2291 (sqrt(rho_l) + sqrt(rho_r))**2._wp
2292# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2293 end do
2294# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2295
2296# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2297 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
2298# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2299 (sqrt(rho_l) + sqrt(rho_r))
2300# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2301
2302# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2303 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
2304# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2305 (sqrt(rho_l) + sqrt(rho_r))
2306# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2307
2308# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2309 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
2310# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2311 (sqrt(rho_l) + sqrt(rho_r))**2._wp
2312# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2313
2314# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2315 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
2316# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2317 (sqrt(rho_l) + sqrt(rho_r))
2318# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2319
2320# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2321 if (chemistry) then
2322# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2323 eps = 0.001_wp
2324# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2325 call get_species_enthalpies_rt(t_l, h_il)
2326# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2327 call get_species_enthalpies_rt(t_r, h_ir)
2328# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2329 h_il = h_il*gas_constant/molecular_weights*t_l
2330# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2331 h_ir = h_ir*gas_constant/molecular_weights*t_r
2332# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2333 call get_species_specific_heats_r(t_l, cp_il)
2334# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2335 call get_species_specific_heats_r(t_r, cp_ir)
2336# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2337
2338# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2339 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
2340# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2341 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
2342# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2343 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
2344# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2345 if (abs(t_l - t_r) < eps) then
2346# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2347 ! Case when T_L and T_R are very close
2348# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2349 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
2350# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2351 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
2352# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2353 else
2354# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2355 ! Normal calculation when T_L and T_R are sufficiently different
2356# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2357 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
2358# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2359 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
2360# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2361 end if
2362# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2363 gamma_avg = cp_avg/cv_avg
2364# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2365
2366# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2367 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
2368# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2369 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
2370# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2371
2372# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2373 end if
2374# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2375
2376# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2377 end if
2378# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2379
2380# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2381 if (avg_state == 2) then
2382# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2383 rho_avg = 5.e-1_wp*(rho_l + rho_r)
2384# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2385 vel_avg_rms = 0._wp
2386# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2387
2388# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2389#if defined(MFC_OpenACC)
2390# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2391!$acc loop seq
2392# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2393#elif defined(MFC_OpenMP)
2394# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2395
2396# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2397#endif
2398# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2399 do i = 1, num_vels
2400# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2401 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
2402# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2403 end do
2404# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2405
2406# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2407 h_avg = 5.e-1_wp*(h_l + h_r)
2408# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2409 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
2410# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2411 qv_avg = 5.e-1_wp*(qv_l + qv_r)
2412# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2413
2414# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2415 end if
2416# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2417
2418
2419 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
2420 vel_l_rms, 0._wp, c_l, qv_l)
2421
2422 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
2423 vel_r_rms, 0._wp, c_r, qv_r)
2424
2425 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
2426 ! variables are placeholders to call the subroutine.
2427
2428 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
2429 vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
2430
2431 if (mhd) then
2432 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
2433 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
2434 end if
2435
2436 if (hyper_cleaning) then ! mhd
2437 c_fast%L = min(c_fast%L, -hyper_cleaning_speed)
2438 c_fast%R = max(c_fast%R, hyper_cleaning_speed)
2439 end if
2440
2441 if (viscous) then
2442 if (chemistry) then
2443 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
2444 end if
2445
2446# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2447#if defined(MFC_OpenACC)
2448# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2449!$acc loop seq
2450# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2451#elif defined(MFC_OpenMP)
2452# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2453
2454# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2455#endif
2456 do i = 1, 2
2457 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
2458 end do
2459 end if
2460
2461 if (wave_speeds == 1) then
2462 if (mhd) then
2463 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
2464 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
2465 elseif (hypoelasticity) then
2466 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
2467 (((4._wp*g_l)/3._wp) + &
2468 tau_e_l(dir_idx_tau(1)))/rho_l) &
2469 , vel_r(dir_idx(1)) - sqrt(c_r*c_r + &
2470 (((4._wp*g_r)/3._wp) + &
2471 tau_e_r(dir_idx_tau(1)))/rho_r))
2472 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
2473 (((4._wp*g_r)/3._wp) + &
2474 tau_e_r(dir_idx_tau(1)))/rho_r) &
2475 , vel_l(dir_idx(1)) + sqrt(c_l*c_l + &
2476 (((4._wp*g_l)/3._wp) + &
2477 tau_e_l(dir_idx_tau(1)))/rho_l))
2478 else if (hyperelasticity) then
2479 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l) &
2480 , vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
2481 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r) &
2482 , vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
2483 else
2484 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
2485 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
2486 end if
2487
2488 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
2489 (s_l - vel_l(dir_idx(1))) - &
2490 rho_r*vel_r(dir_idx(1))* &
2491 (s_r - vel_r(dir_idx(1)))) &
2492 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
2493 rho_r*(s_r - vel_r(dir_idx(1))))
2494 elseif (wave_speeds == 2) then
2495 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
2496 (vel_l(dir_idx(1)) - &
2497 vel_r(dir_idx(1))))
2498
2499 pres_sr = pres_sl
2500
2501 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
2502 (pres_sl/pres_l - 1._wp)*pres_l/ &
2503 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
2504 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
2505 (pres_sr/pres_r - 1._wp)*pres_r/ &
2506 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
2507
2508 s_l = vel_l(dir_idx(1)) - c_l*ms_l
2509 s_r = vel_r(dir_idx(1)) + c_r*ms_r
2510
2511 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
2512 (pres_l - pres_r)/ &
2513 (rho_avg*c_avg))
2514 end if
2515
2516 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
2517
2518 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_l)) &
2519 + (5.e-1_wp - sign(5.e-1_wp, s_l)) &
2520 *(5.e-1_wp + sign(5.e-1_wp, s_r))
2521 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_r)) &
2522 + (5.e-1_wp - sign(5.e-1_wp, s_l)) &
2523 *(5.e-1_wp + sign(5.e-1_wp, s_r))
2524
2525 ! Low Mach correction
2526 if (low_mach == 1) then
2527
2528# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2529 if (riemann_solver == 1 .or. riemann_solver == 5) then
2530# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2531
2532# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2533 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2534# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2535 pcorr = 0._wp
2536# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2537
2538# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2539 if (low_mach == 1) then
2540# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2541 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
2542# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2543 end if
2544# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2545
2546# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2547 else if (riemann_solver == 2) then
2548# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2549 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
2550# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2551 pcorr = 0._wp
2552# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2553
2554# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2555 if (low_mach == 1) then
2556# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2557 pcorr = rho_l*rho_r* &
2558# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2559 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
2560# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2561 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
2562# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2563 (zcoef - 1._wp)
2564# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2565 else if (low_mach == 2) then
2566# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2567 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))))
2568# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2569 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))))
2570# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2571 vel_l(dir_idx(1)) = vel_l_tmp
2572# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2573 vel_r(dir_idx(1)) = vel_r_tmp
2574# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2575 end if
2576# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2577 end if
2578# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2579
2580 else
2581 pcorr = 0._wp
2582 end if
2583
2584 ! Mass
2585 if (.not. relativity) then
2586
2587# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2588#if defined(MFC_OpenACC)
2589# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2590!$acc loop seq
2591# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2592#elif defined(MFC_OpenMP)
2593# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2594
2595# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2596#endif
2597 do i = 1, contxe
2598 flux_rsy_vf(j, k, l, i) = &
2599 (s_m*alpha_rho_r(i)*vel_r(norm_dir) &
2600 - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
2601 + s_m*s_p*(alpha_rho_l(i) &
2602 - alpha_rho_r(i))) &
2603 /(s_m - s_p)
2604 end do
2605 elseif (relativity) then
2606
2607# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2608#if defined(MFC_OpenACC)
2609# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2610!$acc loop seq
2611# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2612#elif defined(MFC_OpenMP)
2613# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2614
2615# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2616#endif
2617 do i = 1, contxe
2618 flux_rsy_vf(j, k, l, i) = &
2619 (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) &
2620 - s_p*ga%L*alpha_rho_l(i)*vel_l(norm_dir) &
2621 + s_m*s_p*(ga%L*alpha_rho_l(i) &
2622 - ga%R*alpha_rho_r(i))) &
2623 /(s_m - s_p)
2624 end do
2625 end if
2626
2627 ! Momentum
2628 if (mhd .and. (.not. relativity)) then
2629
2630# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2631#if defined(MFC_OpenACC)
2632# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2633!$acc loop seq
2634# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2635#elif defined(MFC_OpenMP)
2636# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2637
2638# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2639#endif
2640 do i = 1, 3
2641 ! Flux of rho*v_i in the y direction
2642 ! = rho * v_i * v_y - B_i * B_y + delta_(y,i) * p_tot
2643 flux_rsy_vf(j, k, l, contxe + i) = &
2644 (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) &
2645 - b%R(i)*b%R(norm_dir) &
2646 + dir_flg(i)*(pres_r + pres_mag%R)) &
2647 - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
2648 - b%L(i)*b%L(norm_dir) &
2649 + dir_flg(i)*(pres_l + pres_mag%L)) &
2650 + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i))) &
2651 /(s_m - s_p)
2652 end do
2653 elseif (mhd .and. relativity) then
2654
2655# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2656#if defined(MFC_OpenACC)
2657# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2658!$acc loop seq
2659# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2660#elif defined(MFC_OpenMP)
2661# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2662
2663# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2664#endif
2665 do i = 1, 3
2666 ! Flux of m_i in the y direction
2667 ! = m_i * v_y - b_i/Gamma * B_y + delta_(y,i) * p_tot
2668 flux_rsy_vf(j, k, l, contxe + i) = &
2669 (s_m*(cm%R(i)*vel_r(norm_dir) &
2670 - b4%R(i)/ga%R*b%R(norm_dir) &
2671 + dir_flg(i)*(pres_r + pres_mag%R)) &
2672 - s_p*(cm%L(i)*vel_l(norm_dir) &
2673 - b4%L(i)/ga%L*b%L(norm_dir) &
2674 + dir_flg(i)*(pres_l + pres_mag%L)) &
2675 + s_m*s_p*(cm%L(i) - cm%R(i))) &
2676 /(s_m - s_p)
2677 end do
2678 elseif (bubbles_euler) then
2679
2680# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2681#if defined(MFC_OpenACC)
2682# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2683!$acc loop seq
2684# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2685#elif defined(MFC_OpenMP)
2686# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2687
2688# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2689#endif
2690 do i = 1, num_vels
2691 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
2692 (s_m*(rho_r*vel_r(dir_idx(1)) &
2693 *vel_r(dir_idx(i)) &
2694 + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
2695 - s_p*(rho_l*vel_l(dir_idx(1)) &
2696 *vel_l(dir_idx(i)) &
2697 + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
2698 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
2699 - rho_r*vel_r(dir_idx(i)))) &
2700 /(s_m - s_p) &
2701 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
2702 end do
2703 else if (hypoelasticity) then
2704
2705# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2706#if defined(MFC_OpenACC)
2707# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2708!$acc loop seq
2709# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2710#elif defined(MFC_OpenMP)
2711# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2712
2713# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2714#endif
2715 do i = 1, num_vels
2716 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
2717 (s_m*(rho_r*vel_r(dir_idx(1)) &
2718 *vel_r(dir_idx(i)) &
2719 + dir_flg(dir_idx(i))*pres_r &
2720 - tau_e_r(dir_idx_tau(i))) &
2721 - s_p*(rho_l*vel_l(dir_idx(1)) &
2722 *vel_l(dir_idx(i)) &
2723 + dir_flg(dir_idx(i))*pres_l &
2724 - tau_e_l(dir_idx_tau(i))) &
2725 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
2726 - rho_r*vel_r(dir_idx(i)))) &
2727 /(s_m - s_p)
2728 end do
2729 else
2730
2731# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2732#if defined(MFC_OpenACC)
2733# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2734!$acc loop seq
2735# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2736#elif defined(MFC_OpenMP)
2737# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2738
2739# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2740#endif
2741 do i = 1, num_vels
2742 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
2743 (s_m*(rho_r*vel_r(dir_idx(1)) &
2744 *vel_r(dir_idx(i)) &
2745 + dir_flg(dir_idx(i))*pres_r) &
2746 - s_p*(rho_l*vel_l(dir_idx(1)) &
2747 *vel_l(dir_idx(i)) &
2748 + dir_flg(dir_idx(i))*pres_l) &
2749 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
2750 - rho_r*vel_r(dir_idx(i)))) &
2751 /(s_m - s_p) &
2752 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
2753 end do
2754 end if
2755
2756 ! Energy
2757 if (mhd .and. (.not. relativity)) then
2758 ! energy flux = (E + p + p_mag) * v_y - B_y * (v_x*B_x + v_y*B_y + v_z*B_z)
2759# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2760 flux_rsy_vf(j, k, l, e_idx) = &
2761 (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir)*(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
2762 - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) &
2763 + s_m*s_p*(e_l - e_r)) &
2764 /(s_m - s_p)
2765# 853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2766 elseif (mhd .and. relativity) then
2767 ! energy flux = m_y - mass flux
2768 ! Hard-coded for single-component for now
2769 flux_rsy_vf(j, k, l, e_idx) = &
2770 (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
2771 - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) &
2772 + s_m*s_p*(e_l - e_r)) &
2773 /(s_m - s_p)
2774 else if (bubbles_euler) then
2775 flux_rsy_vf(j, k, l, e_idx) = &
2776 (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
2777 - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) &
2778 + s_m*s_p*(e_l - e_r)) &
2779 /(s_m - s_p) &
2780 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
2781 else if (hypoelasticity) then
2782 flux_tau_l = 0._wp; flux_tau_r = 0._wp
2783
2784# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2785#if defined(MFC_OpenACC)
2786# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2787!$acc loop seq
2788# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2789#elif defined(MFC_OpenMP)
2790# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2791
2792# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2793#endif
2794 do i = 1, num_dims
2795 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
2796 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
2797 end do
2798 flux_rsy_vf(j, k, l, e_idx) = &
2799 (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
2800 - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) &
2801 + s_m*s_p*(e_l - e_r))/(s_m - s_p)
2802 else
2803 flux_rsy_vf(j, k, l, e_idx) = &
2804 (s_m*vel_r(dir_idx(1))*(e_r + pres_r) &
2805 - s_p*vel_l(dir_idx(1))*(e_l + pres_l) &
2806 + s_m*s_p*(e_l - e_r)) &
2807 /(s_m - s_p) &
2808 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
2809 end if
2810
2811 ! Elastic Stresses
2812 if (hypoelasticity) then
2813 do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow
2814 flux_rsy_vf(j, k, l, strxb - 1 + i) = &
2815 (s_m*(rho_r*vel_r(dir_idx(1)) &
2816 *tau_e_r(i)) &
2817 - s_p*(rho_l*vel_l(dir_idx(1)) &
2818 *tau_e_l(i)) &
2819 + s_m*s_p*(rho_l*tau_e_l(i) &
2820 - rho_r*tau_e_r(i))) &
2821 /(s_m - s_p)
2822 end do
2823 end if
2824
2825 ! Advection
2826
2827# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2828#if defined(MFC_OpenACC)
2829# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2830!$acc loop seq
2831# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2832#elif defined(MFC_OpenMP)
2833# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2834
2835# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2836#endif
2837 do i = advxb, advxe
2838 flux_rsy_vf(j, k, l, i) = &
2839 (ql_prim_rsy_vf(j, k, l, i) &
2840 - qr_prim_rsy_vf(j + 1, k, l, i)) &
2841 *s_m*s_p/(s_m - s_p)
2842 flux_src_rsy_vf(j, k, l, i) = &
2843 (s_m*qr_prim_rsy_vf(j + 1, k, l, i) &
2844 - s_p*ql_prim_rsy_vf(j, k, l, i)) &
2845 /(s_m - s_p)
2846 end do
2847
2848 if (bubbles_euler) then
2849 ! From HLLC: Kills mass transport @ bubble gas density
2850 if (num_fluids > 1) then
2851 flux_rsy_vf(j, k, l, contxe) = 0._wp
2852 end if
2853 end if
2854
2855 if (chemistry) then
2856
2857# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2858#if defined(MFC_OpenACC)
2859# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2860!$acc loop seq
2861# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2862#elif defined(MFC_OpenMP)
2863# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2864
2865# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2866#endif
2867 do i = chemxb, chemxe
2868 y_l = ql_prim_rsy_vf(j, k, l, i)
2869 y_r = qr_prim_rsy_vf(j + 1, k, l, i)
2870
2871 flux_rsy_vf(j, k, l, i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) &
2872 - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
2873 + s_m*s_p*(y_l*rho_l - y_r*rho_r)) &
2874 /(s_m - s_p)
2875 flux_src_rsy_vf(j, k, l, i) = 0._wp
2876 end do
2877 end if
2878
2879 if (mhd) then
2880 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
2881 ! B_y flux = v_x * B_y - v_y * Bx0
2882 ! B_z flux = v_x * B_z - v_z * Bx0
2883
2884# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2885#if defined(MFC_OpenACC)
2886# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2887!$acc loop seq
2888# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2889#elif defined(MFC_OpenMP)
2890# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2891
2892# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2893#endif
2894 do i = 0, 1
2895 flux_rsx_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
2896 - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) &
2897 + s_m*s_p*(b%L(2 + i) - b%R(2 + i)))/(s_m - s_p)
2898 end do
2899 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
2900 ! B_x d/dy flux = (1 - delta(x,y)) * (v_y * B_x - v_x * B_y)
2901 ! B_y d/dy flux = (1 - delta(y,y)) * (v_y * B_y - v_y * B_y)
2902 ! B_z d/dy flux = (1 - delta(z,y)) * (v_y * B_z - v_z * B_y)
2903
2904# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2905#if defined(MFC_OpenACC)
2906# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2907!$acc loop seq
2908# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2909#elif defined(MFC_OpenMP)
2910# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2911
2912# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2913#endif
2914 do i = 0, 2
2915 flux_rsy_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1)*b%R(norm_dir)) - &
2916 s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + &
2917 s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
2918 end do
2919
2920 if (hyper_cleaning) then
2921 ! propagate magnetic field divergence as a wave
2922 flux_rsy_vf(j, k, l, b_idx%beg + norm_dir - 1) = flux_rsy_vf(j, k, l, b_idx%beg + norm_dir - 1) + &
2923 (s_m*qr_prim_rsy_vf(j + 1, k, l, psi_idx) - s_p*ql_prim_rsy_vf(j, k, l, psi_idx))/(s_m - s_p)
2924
2925 flux_rsy_vf(j, k, l, psi_idx) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsy_vf(j, k, l, psi_idx) - qr_prim_rsy_vf(j + 1, k, l, psi_idx)))/(s_m - s_p)
2926 else
2927 flux_rsy_vf(j, k, l, b_idx%beg + norm_dir - 1) = 0._wp ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
2928 end if
2929 end if
2930 flux_src_rsy_vf(j, k, l, advxb) = 0._wp
2931 end if
2932
2933# 971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2934 if (cyl_coord) then
2935 !Substituting the advective flux into the inviscid geometrical source flux
2936
2937# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2938#if defined(MFC_OpenACC)
2939# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2940!$acc loop seq
2941# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2942#elif defined(MFC_OpenMP)
2943# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2944
2945# 973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2946#endif
2947 do i = 1, e_idx
2948 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
2949 end do
2950 ! Recalculating the radial momentum geometric source flux
2951 flux_gsrc_rsy_vf(j, k, l, contxe + 2) = &
2952 flux_rsy_vf(j, k, l, contxe + 2) &
2953 - (s_m*pres_r - s_p*pres_l)/(s_m - s_p)
2954 ! Geometrical source of the void fraction(s) is zero
2955
2956# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2957#if defined(MFC_OpenACC)
2958# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2959!$acc loop seq
2960# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2961#elif defined(MFC_OpenMP)
2962# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2963
2964# 982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2965#endif
2966 do i = advxb, advxe
2967 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
2968 end do
2969 end if
2970
2971 if (cyl_coord .and. hypoelasticity) then
2972 ! += tau_sigmasigma using HLL
2973 flux_gsrc_rsy_vf(j, k, l, contxe + 2) = &
2974 flux_gsrc_rsy_vf(j, k, l, contxe + 2) + &
2975 (s_m*tau_e_r(4) - s_p*tau_e_l(4)) &
2976 /(s_m - s_p)
2977
2978
2979# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2980#if defined(MFC_OpenACC)
2981# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2982!$acc loop seq
2983# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2984#elif defined(MFC_OpenMP)
2985# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2986
2987# 995 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2988#endif
2989 do i = strxb, strxe
2990 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
2991 end do
2992 end if
2993# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
2994
2995 end do
2996 end do
2997 end do
2998
2999# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3000
3001# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3002#if defined(MFC_OpenACC)
3003# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3004!$acc end parallel loop
3005# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3006#elif defined(MFC_OpenMP)
3007# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3008
3009# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3010
3011# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3012!$omp end target teams loop
3013# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3014#endif
3015# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3016
3017 end if
3018
3019# 362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3020
3021 if (norm_dir == 3) then
3022
3023# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3024
3025# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3026#if defined(MFC_OpenACC)
3027# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3028!$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)
3029# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3030#elif defined(MFC_OpenMP)
3031# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3032
3033# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3034
3035# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3036
3037# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3038!$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)
3039# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3040#endif
3041# 364 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3042
3043 do l = is3%beg, is3%end
3044 do k = is2%beg, is2%end
3045 do j = is1%beg, is1%end
3046
3047# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3048#if defined(MFC_OpenACC)
3049# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3050!$acc loop seq
3051# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3052#elif defined(MFC_OpenMP)
3053# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3054
3055# 368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3056#endif
3057 do i = 1, contxe
3058 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
3059 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
3060 end do
3061
3062 vel_l_rms = 0._wp; vel_r_rms = 0._wp
3063
3064
3065# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3066#if defined(MFC_OpenACC)
3067# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3068!$acc loop seq
3069# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3070#elif defined(MFC_OpenMP)
3071# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3072
3073# 376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3074#endif
3075 do i = 1, num_vels
3076 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
3077 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
3078 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
3079 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
3080 end do
3081
3082
3083# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3084#if defined(MFC_OpenACC)
3085# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3086!$acc loop seq
3087# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3088#elif defined(MFC_OpenMP)
3089# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3090
3091# 384 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3092#endif
3093 do i = 1, num_fluids
3094 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
3095 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
3096 end do
3097
3098 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
3099 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
3100
3101 if (mhd) then
3102 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
3103 b%L(1) = bx0
3104 b%R(1) = bx0
3105 b%L(2) = ql_prim_rsz_vf(j, k, l, b_idx%beg)
3106 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg)
3107 b%L(3) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)
3108 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 1)
3109 else ! 2D/3D: Bx, By, Bz as variables
3110 b%L(1) = ql_prim_rsz_vf(j, k, l, b_idx%beg)
3111 b%R(1) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg)
3112 b%L(2) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)
3113 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 1)
3114 b%L(3) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 2)
3115 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 2)
3116 end if
3117 end if
3118
3119 rho_l = 0._wp
3120 gamma_l = 0._wp
3121 pi_inf_l = 0._wp
3122 qv_l = 0._wp
3123
3124 rho_r = 0._wp
3125 gamma_r = 0._wp
3126 pi_inf_r = 0._wp
3127 qv_r = 0._wp
3128
3129 alpha_l_sum = 0._wp
3130 alpha_r_sum = 0._wp
3131
3132 pres_mag%L = 0._wp
3133 pres_mag%R = 0._wp
3134
3135 if (mpp_lim) then
3136
3137# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3138#if defined(MFC_OpenACC)
3139# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3140!$acc loop seq
3141# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3142#elif defined(MFC_OpenMP)
3143# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3144
3145# 428 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3146#endif
3147 do i = 1, num_fluids
3148 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
3149 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
3150 alpha_l_sum = alpha_l_sum + alpha_l(i)
3151 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
3152 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
3153 alpha_r_sum = alpha_r_sum + alpha_r(i)
3154 end do
3155
3156 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
3157 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
3158 end if
3159
3160
3161# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3162#if defined(MFC_OpenACC)
3163# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3164!$acc loop seq
3165# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3166#elif defined(MFC_OpenMP)
3167# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3168
3169# 442 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3170#endif
3171 do i = 1, num_fluids
3172 rho_l = rho_l + alpha_rho_l(i)
3173 gamma_l = gamma_l + alpha_l(i)*gammas(i)
3174 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
3175 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
3176
3177 rho_r = rho_r + alpha_rho_r(i)
3178 gamma_r = gamma_r + alpha_r(i)*gammas(i)
3179 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
3180 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
3181 end do
3182
3183 if (viscous) then
3184
3185# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3186#if defined(MFC_OpenACC)
3187# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3188!$acc loop seq
3189# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3190#elif defined(MFC_OpenMP)
3191# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3192
3193# 456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3194#endif
3195 do i = 1, 2
3196 re_l(i) = dflt_real
3197 re_r(i) = dflt_real
3198
3199 if (re_size(i) > 0) re_l(i) = 0._wp
3200 if (re_size(i) > 0) re_r(i) = 0._wp
3201
3202
3203# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3204#if defined(MFC_OpenACC)
3205# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3206!$acc loop seq
3207# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3208#elif defined(MFC_OpenMP)
3209# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3210
3211# 464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3212#endif
3213 do q = 1, re_size(i)
3214 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
3215 + re_l(i)
3216 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
3217 + re_r(i)
3218 end do
3219
3220 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
3221 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
3222 end do
3223 end if
3224
3225 if (chemistry) then
3226
3227# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3228#if defined(MFC_OpenACC)
3229# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3230!$acc loop seq
3231# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3232#elif defined(MFC_OpenMP)
3233# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3234
3235# 478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3236#endif
3237 do i = chemxb, chemxe
3238 ys_l(i - chemxb + 1) = ql_prim_rsz_vf(j, k, l, i)
3239 ys_r(i - chemxb + 1) = qr_prim_rsz_vf(j + 1, k, l, i)
3240 end do
3241
3242 call get_mixture_molecular_weight(ys_l, mw_l)
3243 call get_mixture_molecular_weight(ys_r, mw_r)
3244# 490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3245 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
3246 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
3247# 493 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3248
3249 r_gas_l = gas_constant/mw_l
3250 r_gas_r = gas_constant/mw_r
3251 t_l = pres_l/rho_l/r_gas_l
3252 t_r = pres_r/rho_r/r_gas_r
3253
3254 call get_species_specific_heats_r(t_l, cp_il)
3255 call get_species_specific_heats_r(t_r, cp_ir)
3256
3257 if (chem_params%gamma_method == 1) then
3258 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
3259 gamma_il = cp_il/(cp_il - 1.0_wp)
3260 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
3261
3262 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
3263 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
3264 else if (chem_params%gamma_method == 2) then
3265 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
3266 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
3267 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
3268 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
3269 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
3270
3271 gamm_l = cp_l/cv_l
3272 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
3273 gamm_r = cp_r/cv_r
3274 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
3275 end if
3276
3277 call get_mixture_energy_mass(t_l, ys_l, e_l)
3278 call get_mixture_energy_mass(t_r, ys_r, e_r)
3279
3280 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
3281 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
3282 h_l = (e_l + pres_l)/rho_l
3283 h_r = (e_r + pres_r)/rho_r
3284 elseif (mhd .and. relativity) then
3285 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
3286 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
3287# 533 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3288 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
3289 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
3290
3291 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
3292 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
3293 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
3294 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
3295# 541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3296
3297 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
3298 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
3299
3300 ! Hard-coded EOS
3301 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
3302 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
3303# 549 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3304 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
3305 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
3306# 552 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3307
3308 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
3309 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
3310 elseif (mhd .and. .not. relativity) then
3311# 557 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3312 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
3313 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
3314# 560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3315 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
3316 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R ! includes magnetic energy
3317 h_l = (e_l + pres_l - pres_mag%L)/rho_l
3318 h_r = (e_r + pres_r - pres_mag%R)/rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
3319 else
3320 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
3321 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
3322 h_l = (e_l + pres_l)/rho_l
3323 h_r = (e_r + pres_r)/rho_r
3324 end if
3325
3326 ! elastic energy update
3327 if (hypoelasticity) then
3328 g_l = 0._wp; g_r = 0._wp
3329
3330
3331# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3332#if defined(MFC_OpenACC)
3333# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3334!$acc loop seq
3335# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3336#elif defined(MFC_OpenMP)
3337# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3338
3339# 575 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3340#endif
3341 do i = 1, num_fluids
3342 g_l = g_l + alpha_l(i)*gs_rs(i)
3343 g_r = g_r + alpha_r(i)*gs_rs(i)
3344 end do
3345
3346 if (cont_damage) then
3347 g_l = g_l*max((1._wp - ql_prim_rsz_vf(j, k, l, damage_idx)), 0._wp)
3348 g_r = g_r*max((1._wp - qr_prim_rsz_vf(j, k, l, damage_idx)), 0._wp)
3349 end if
3350
3351
3352# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3353#if defined(MFC_OpenACC)
3354# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3355!$acc loop seq
3356# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3357#elif defined(MFC_OpenMP)
3358# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3359
3360# 586 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3361#endif
3362 do i = 1, strxe - strxb + 1
3363 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
3364 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
3365 ! Elastic contribution to energy if G large enough
3366 !TODO take out if statement if stable without
3367 if ((g_l > 1000) .and. (g_r > 1000)) then
3368 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
3369 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
3370 ! Double for shear stresses
3371 if (any(strxb - 1 + i == shear_indices)) then
3372 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
3373 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
3374 end if
3375 end if
3376 end do
3377 end if
3378
3379 ! elastic energy update
3380 !if ( hyperelasticity ) then
3381 ! G_L = 0._wp
3382 ! G_R = 0._wp
3383 !
3384 ! $:GPU_LOOP(parallelism='[seq]')
3385 ! do i = 1, num_fluids
3386 ! G_L = G_L + alpha_L(i)*Gs_rs(i)
3387 ! G_R = G_R + alpha_R(i)*Gs_rs(i)
3388 ! end do
3389 ! ! Elastic contribution to energy if G large enough
3390 ! if ((G_L > 1.e-3_wp) .and. (G_R > 1.e-3_wp)) then
3391 ! E_L = E_L + G_L*qL_prim_rsz_vf(j, k, l, xiend + 1)
3392 ! E_R = E_R + G_R*qR_prim_rsz_vf(j + 1, k, l, xiend + 1)
3393 ! $:GPU_LOOP(parallelism='[seq]')
3394 ! do i = 1, b_size-1
3395 ! tau_e_L(i) = G_L*qL_prim_rsz_vf(j, k, l, strxb - 1 + i)
3396 ! tau_e_R(i) = G_R*qR_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
3397 ! end do
3398 ! $:GPU_LOOP(parallelism='[seq]')
3399 ! do i = 1, b_size-1
3400 ! tau_e_L(i) = 0._wp
3401 ! tau_e_R(i) = 0._wp
3402 ! end do
3403 ! $:GPU_LOOP(parallelism='[seq]')
3404 ! do i = 1, num_dims
3405 ! xi_field_L(i) = qL_prim_rsz_vf(j, k, l, xibeg - 1 + i)
3406 ! xi_field_R(i) = qR_prim_rsz_vf(j + 1, k, l, xibeg - 1 + i)
3407 ! end do
3408 ! end if
3409 !end if
3410
3411
3412# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3413 if (avg_state == 1) then
3414# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3415
3416# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3417 rho_avg = sqrt(rho_l*rho_r)
3418# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3419
3420# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3421 vel_avg_rms = 0._wp
3422# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3423
3424# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3425
3426# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3427#if defined(MFC_OpenACC)
3428# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3429!$acc loop seq
3430# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3431#elif defined(MFC_OpenMP)
3432# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3433
3434# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3435#endif
3436# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3437 do i = 1, num_vels
3438# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3439 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
3440# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3441 (sqrt(rho_l) + sqrt(rho_r))**2._wp
3442# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3443 end do
3444# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3445
3446# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3447 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
3448# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3449 (sqrt(rho_l) + sqrt(rho_r))
3450# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3451
3452# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3453 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
3454# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3455 (sqrt(rho_l) + sqrt(rho_r))
3456# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3457
3458# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3459 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
3460# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3461 (sqrt(rho_l) + sqrt(rho_r))**2._wp
3462# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3463
3464# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3465 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
3466# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3467 (sqrt(rho_l) + sqrt(rho_r))
3468# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3469
3470# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3471 if (chemistry) then
3472# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3473 eps = 0.001_wp
3474# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3475 call get_species_enthalpies_rt(t_l, h_il)
3476# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3477 call get_species_enthalpies_rt(t_r, h_ir)
3478# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3479 h_il = h_il*gas_constant/molecular_weights*t_l
3480# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3481 h_ir = h_ir*gas_constant/molecular_weights*t_r
3482# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3483 call get_species_specific_heats_r(t_l, cp_il)
3484# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3485 call get_species_specific_heats_r(t_r, cp_ir)
3486# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3487
3488# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3489 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
3490# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3491 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
3492# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3493 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
3494# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3495 if (abs(t_l - t_r) < eps) then
3496# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3497 ! Case when T_L and T_R are very close
3498# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3499 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
3500# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3501 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
3502# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3503 else
3504# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3505 ! Normal calculation when T_L and T_R are sufficiently different
3506# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3507 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
3508# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3509 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
3510# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3511 end if
3512# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3513 gamma_avg = cp_avg/cv_avg
3514# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3515
3516# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3517 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
3518# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3519 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
3520# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3521
3522# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3523 end if
3524# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3525
3526# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3527 end if
3528# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3529
3530# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3531 if (avg_state == 2) then
3532# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3533 rho_avg = 5.e-1_wp*(rho_l + rho_r)
3534# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3535 vel_avg_rms = 0._wp
3536# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3537
3538# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3539#if defined(MFC_OpenACC)
3540# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3541!$acc loop seq
3542# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3543#elif defined(MFC_OpenMP)
3544# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3545
3546# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3547#endif
3548# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3549 do i = 1, num_vels
3550# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3551 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
3552# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3553 end do
3554# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3555
3556# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3557 h_avg = 5.e-1_wp*(h_l + h_r)
3558# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3559 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
3560# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3561 qv_avg = 5.e-1_wp*(qv_l + qv_r)
3562# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3563
3564# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3565 end if
3566# 636 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3567
3568
3569 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
3570 vel_l_rms, 0._wp, c_l, qv_l)
3571
3572 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
3573 vel_r_rms, 0._wp, c_r, qv_r)
3574
3575 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
3576 ! variables are placeholders to call the subroutine.
3577
3578 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
3579 vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
3580
3581 if (mhd) then
3582 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
3583 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
3584 end if
3585
3586 if (hyper_cleaning) then ! mhd
3587 c_fast%L = min(c_fast%L, -hyper_cleaning_speed)
3588 c_fast%R = max(c_fast%R, hyper_cleaning_speed)
3589 end if
3590
3591 if (viscous) then
3592 if (chemistry) then
3593 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
3594 end if
3595
3596# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3597#if defined(MFC_OpenACC)
3598# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3599!$acc loop seq
3600# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3601#elif defined(MFC_OpenMP)
3602# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3603
3604# 664 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3605#endif
3606 do i = 1, 2
3607 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
3608 end do
3609 end if
3610
3611 if (wave_speeds == 1) then
3612 if (mhd) then
3613 s_l = min(vel_l(dir_idx(1)) - c_fast%L, vel_r(dir_idx(1)) - c_fast%R)
3614 s_r = max(vel_r(dir_idx(1)) + c_fast%R, vel_l(dir_idx(1)) + c_fast%L)
3615 elseif (hypoelasticity) then
3616 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
3617 (((4._wp*g_l)/3._wp) + &
3618 tau_e_l(dir_idx_tau(1)))/rho_l) &
3619 , vel_r(dir_idx(1)) - sqrt(c_r*c_r + &
3620 (((4._wp*g_r)/3._wp) + &
3621 tau_e_r(dir_idx_tau(1)))/rho_r))
3622 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
3623 (((4._wp*g_r)/3._wp) + &
3624 tau_e_r(dir_idx_tau(1)))/rho_r) &
3625 , vel_l(dir_idx(1)) + sqrt(c_l*c_l + &
3626 (((4._wp*g_l)/3._wp) + &
3627 tau_e_l(dir_idx_tau(1)))/rho_l))
3628 else if (hyperelasticity) then
3629 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l) &
3630 , vel_r(dir_idx(1)) - sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r))
3631 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + (4._wp*g_r/3._wp)/rho_r) &
3632 , vel_l(dir_idx(1)) + sqrt(c_l*c_l + (4._wp*g_l/3._wp)/rho_l))
3633 else
3634 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
3635 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
3636 end if
3637
3638 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
3639 (s_l - vel_l(dir_idx(1))) - &
3640 rho_r*vel_r(dir_idx(1))* &
3641 (s_r - vel_r(dir_idx(1)))) &
3642 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
3643 rho_r*(s_r - vel_r(dir_idx(1))))
3644 elseif (wave_speeds == 2) then
3645 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
3646 (vel_l(dir_idx(1)) - &
3647 vel_r(dir_idx(1))))
3648
3649 pres_sr = pres_sl
3650
3651 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
3652 (pres_sl/pres_l - 1._wp)*pres_l/ &
3653 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
3654 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
3655 (pres_sr/pres_r - 1._wp)*pres_r/ &
3656 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
3657
3658 s_l = vel_l(dir_idx(1)) - c_l*ms_l
3659 s_r = vel_r(dir_idx(1)) + c_r*ms_r
3660
3661 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
3662 (pres_l - pres_r)/ &
3663 (rho_avg*c_avg))
3664 end if
3665
3666 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
3667
3668 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_l)) &
3669 + (5.e-1_wp - sign(5.e-1_wp, s_l)) &
3670 *(5.e-1_wp + sign(5.e-1_wp, s_r))
3671 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_r)) &
3672 + (5.e-1_wp - sign(5.e-1_wp, s_l)) &
3673 *(5.e-1_wp + sign(5.e-1_wp, s_r))
3674
3675 ! Low Mach correction
3676 if (low_mach == 1) then
3677
3678# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3679 if (riemann_solver == 1 .or. riemann_solver == 5) then
3680# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3681
3682# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3683 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3684# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3685 pcorr = 0._wp
3686# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3687
3688# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3689 if (low_mach == 1) then
3690# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3691 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
3692# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3693 end if
3694# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3695
3696# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3697 else if (riemann_solver == 2) then
3698# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3699 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
3700# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3701 pcorr = 0._wp
3702# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3703
3704# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3705 if (low_mach == 1) then
3706# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3707 pcorr = rho_l*rho_r* &
3708# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3709 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
3710# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3711 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
3712# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3713 (zcoef - 1._wp)
3714# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3715 else if (low_mach == 2) then
3716# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3717 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))))
3718# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3719 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))))
3720# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3721 vel_l(dir_idx(1)) = vel_l_tmp
3722# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3723 vel_r(dir_idx(1)) = vel_r_tmp
3724# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3725 end if
3726# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3727 end if
3728# 736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3729
3730 else
3731 pcorr = 0._wp
3732 end if
3733
3734 ! Mass
3735 if (.not. relativity) then
3736
3737# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3738#if defined(MFC_OpenACC)
3739# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3740!$acc loop seq
3741# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3742#elif defined(MFC_OpenMP)
3743# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3744
3745# 743 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3746#endif
3747 do i = 1, contxe
3748 flux_rsz_vf(j, k, l, i) = &
3749 (s_m*alpha_rho_r(i)*vel_r(norm_dir) &
3750 - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
3751 + s_m*s_p*(alpha_rho_l(i) &
3752 - alpha_rho_r(i))) &
3753 /(s_m - s_p)
3754 end do
3755 elseif (relativity) then
3756
3757# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3758#if defined(MFC_OpenACC)
3759# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3760!$acc loop seq
3761# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3762#elif defined(MFC_OpenMP)
3763# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3764
3765# 753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3766#endif
3767 do i = 1, contxe
3768 flux_rsz_vf(j, k, l, i) = &
3769 (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) &
3770 - s_p*ga%L*alpha_rho_l(i)*vel_l(norm_dir) &
3771 + s_m*s_p*(ga%L*alpha_rho_l(i) &
3772 - ga%R*alpha_rho_r(i))) &
3773 /(s_m - s_p)
3774 end do
3775 end if
3776
3777 ! Momentum
3778 if (mhd .and. (.not. relativity)) then
3779
3780# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3781#if defined(MFC_OpenACC)
3782# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3783!$acc loop seq
3784# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3785#elif defined(MFC_OpenMP)
3786# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3787
3788# 766 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3789#endif
3790 do i = 1, 3
3791 ! Flux of rho*v_i in the z direction
3792 ! = rho * v_i * v_z - B_i * B_z + delta_(z,i) * p_tot
3793 flux_rsz_vf(j, k, l, contxe + i) = &
3794 (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) &
3795 - b%R(i)*b%R(norm_dir) &
3796 + dir_flg(i)*(pres_r + pres_mag%R)) &
3797 - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
3798 - b%L(i)*b%L(norm_dir) &
3799 + dir_flg(i)*(pres_l + pres_mag%L)) &
3800 + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i))) &
3801 /(s_m - s_p)
3802 end do
3803 elseif (mhd .and. relativity) then
3804
3805# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3806#if defined(MFC_OpenACC)
3807# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3808!$acc loop seq
3809# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3810#elif defined(MFC_OpenMP)
3811# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3812
3813# 781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3814#endif
3815 do i = 1, 3
3816 ! Flux of m_i in the z direction
3817 ! = m_i * v_z - b_i/Gamma * B_z + delta_(z,i) * p_tot
3818 flux_rsz_vf(j, k, l, contxe + i) = &
3819 (s_m*(cm%R(i)*vel_r(norm_dir) &
3820 - b4%R(i)/ga%R*b%R(norm_dir) &
3821 + dir_flg(i)*(pres_r + pres_mag%R)) &
3822 - s_p*(cm%L(i)*vel_l(norm_dir) &
3823 - b4%L(i)/ga%L*b%L(norm_dir) &
3824 + dir_flg(i)*(pres_l + pres_mag%L)) &
3825 + s_m*s_p*(cm%L(i) - cm%R(i))) &
3826 /(s_m - s_p)
3827 end do
3828 elseif (bubbles_euler) then
3829
3830# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3831#if defined(MFC_OpenACC)
3832# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3833!$acc loop seq
3834# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3835#elif defined(MFC_OpenMP)
3836# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3837
3838# 796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3839#endif
3840 do i = 1, num_vels
3841 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
3842 (s_m*(rho_r*vel_r(dir_idx(1)) &
3843 *vel_r(dir_idx(i)) &
3844 + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
3845 - s_p*(rho_l*vel_l(dir_idx(1)) &
3846 *vel_l(dir_idx(i)) &
3847 + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
3848 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
3849 - rho_r*vel_r(dir_idx(i)))) &
3850 /(s_m - s_p) &
3851 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
3852 end do
3853 else if (hypoelasticity) then
3854
3855# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3856#if defined(MFC_OpenACC)
3857# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3858!$acc loop seq
3859# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3860#elif defined(MFC_OpenMP)
3861# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3862
3863# 811 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3864#endif
3865 do i = 1, num_vels
3866 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
3867 (s_m*(rho_r*vel_r(dir_idx(1)) &
3868 *vel_r(dir_idx(i)) &
3869 + dir_flg(dir_idx(i))*pres_r &
3870 - tau_e_r(dir_idx_tau(i))) &
3871 - s_p*(rho_l*vel_l(dir_idx(1)) &
3872 *vel_l(dir_idx(i)) &
3873 + dir_flg(dir_idx(i))*pres_l &
3874 - tau_e_l(dir_idx_tau(i))) &
3875 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
3876 - rho_r*vel_r(dir_idx(i)))) &
3877 /(s_m - s_p)
3878 end do
3879 else
3880
3881# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3882#if defined(MFC_OpenACC)
3883# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3884!$acc loop seq
3885# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3886#elif defined(MFC_OpenMP)
3887# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3888
3889# 827 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3890#endif
3891 do i = 1, num_vels
3892 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
3893 (s_m*(rho_r*vel_r(dir_idx(1)) &
3894 *vel_r(dir_idx(i)) &
3895 + dir_flg(dir_idx(i))*pres_r) &
3896 - s_p*(rho_l*vel_l(dir_idx(1)) &
3897 *vel_l(dir_idx(i)) &
3898 + dir_flg(dir_idx(i))*pres_l) &
3899 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
3900 - rho_r*vel_r(dir_idx(i)))) &
3901 /(s_m - s_p) &
3902 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
3903 end do
3904 end if
3905
3906 ! Energy
3907 if (mhd .and. (.not. relativity)) then
3908 ! energy flux = (E + p + p_mag) * v_z - B_z * (v_x*B_x + v_y*B_y + v_z*B_z)
3909# 847 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3910 flux_rsz_vf(j, k, l, e_idx) = &
3911 (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir)*(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
3912 - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) &
3913 + s_m*s_p*(e_l - e_r)) &
3914 /(s_m - s_p)
3915# 853 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3916 elseif (mhd .and. relativity) then
3917 ! energy flux = m_z - mass flux
3918 ! Hard-coded for single-component for now
3919 flux_rsz_vf(j, k, l, e_idx) = &
3920 (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
3921 - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) &
3922 + s_m*s_p*(e_l - e_r)) &
3923 /(s_m - s_p)
3924 else if (bubbles_euler) then
3925 flux_rsz_vf(j, k, l, e_idx) = &
3926 (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
3927 - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) &
3928 + s_m*s_p*(e_l - e_r)) &
3929 /(s_m - s_p) &
3930 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
3931 else if (hypoelasticity) then
3932 flux_tau_l = 0._wp; flux_tau_r = 0._wp
3933
3934# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3935#if defined(MFC_OpenACC)
3936# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3937!$acc loop seq
3938# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3939#elif defined(MFC_OpenMP)
3940# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3941
3942# 870 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3943#endif
3944 do i = 1, num_dims
3945 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
3946 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
3947 end do
3948 flux_rsz_vf(j, k, l, e_idx) = &
3949 (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
3950 - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) &
3951 + s_m*s_p*(e_l - e_r))/(s_m - s_p)
3952 else
3953 flux_rsz_vf(j, k, l, e_idx) = &
3954 (s_m*vel_r(dir_idx(1))*(e_r + pres_r) &
3955 - s_p*vel_l(dir_idx(1))*(e_l + pres_l) &
3956 + s_m*s_p*(e_l - e_r)) &
3957 /(s_m - s_p) &
3958 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
3959 end if
3960
3961 ! Elastic Stresses
3962 if (hypoelasticity) then
3963 do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow
3964 flux_rsz_vf(j, k, l, strxb - 1 + i) = &
3965 (s_m*(rho_r*vel_r(dir_idx(1)) &
3966 *tau_e_r(i)) &
3967 - s_p*(rho_l*vel_l(dir_idx(1)) &
3968 *tau_e_l(i)) &
3969 + s_m*s_p*(rho_l*tau_e_l(i) &
3970 - rho_r*tau_e_r(i))) &
3971 /(s_m - s_p)
3972 end do
3973 end if
3974
3975 ! Advection
3976
3977# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3978#if defined(MFC_OpenACC)
3979# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3980!$acc loop seq
3981# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3982#elif defined(MFC_OpenMP)
3983# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3984
3985# 903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
3986#endif
3987 do i = advxb, advxe
3988 flux_rsz_vf(j, k, l, i) = &
3989 (ql_prim_rsz_vf(j, k, l, i) &
3990 - qr_prim_rsz_vf(j + 1, k, l, i)) &
3991 *s_m*s_p/(s_m - s_p)
3992 flux_src_rsz_vf(j, k, l, i) = &
3993 (s_m*qr_prim_rsz_vf(j + 1, k, l, i) &
3994 - s_p*ql_prim_rsz_vf(j, k, l, i)) &
3995 /(s_m - s_p)
3996 end do
3997
3998 if (bubbles_euler) then
3999 ! From HLLC: Kills mass transport @ bubble gas density
4000 if (num_fluids > 1) then
4001 flux_rsz_vf(j, k, l, contxe) = 0._wp
4002 end if
4003 end if
4004
4005 if (chemistry) then
4006
4007# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4008#if defined(MFC_OpenACC)
4009# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4010!$acc loop seq
4011# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4012#elif defined(MFC_OpenMP)
4013# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4014
4015# 923 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4016#endif
4017 do i = chemxb, chemxe
4018 y_l = ql_prim_rsz_vf(j, k, l, i)
4019 y_r = qr_prim_rsz_vf(j + 1, k, l, i)
4020
4021 flux_rsz_vf(j, k, l, i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) &
4022 - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
4023 + s_m*s_p*(y_l*rho_l - y_r*rho_r)) &
4024 /(s_m - s_p)
4025 flux_src_rsz_vf(j, k, l, i) = 0._wp
4026 end do
4027 end if
4028
4029 if (mhd) then
4030 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
4031 ! B_y flux = v_x * B_y - v_y * Bx0
4032 ! B_z flux = v_x * B_z - v_z * Bx0
4033
4034# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4035#if defined(MFC_OpenACC)
4036# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4037!$acc loop seq
4038# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4039#elif defined(MFC_OpenMP)
4040# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4041
4042# 940 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4043#endif
4044 do i = 0, 1
4045 flux_rsx_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
4046 - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) &
4047 + s_m*s_p*(b%L(2 + i) - b%R(2 + i)))/(s_m - s_p)
4048 end do
4049 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
4050 ! B_x d/dz flux = (1 - delta(x,z)) * (v_z * B_x - v_x * B_z)
4051 ! B_y d/dz flux = (1 - delta(y,z)) * (v_z * B_y - v_y * B_z)
4052 ! B_z d/dz flux = (1 - delta(z,z)) * (v_z * B_z - v_z * B_z)
4053
4054# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4055#if defined(MFC_OpenACC)
4056# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4057!$acc loop seq
4058# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4059#elif defined(MFC_OpenMP)
4060# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4061
4062# 950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4063#endif
4064 do i = 0, 2
4065 flux_rsz_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1)*b%R(norm_dir)) - &
4066 s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + &
4067 s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
4068 end do
4069
4070 if (hyper_cleaning) then
4071 ! propagate magnetic field divergence as a wave
4072 flux_rsz_vf(j, k, l, b_idx%beg + norm_dir - 1) = flux_rsz_vf(j, k, l, b_idx%beg + norm_dir - 1) + &
4073 (s_m*qr_prim_rsz_vf(j + 1, k, l, psi_idx) - s_p*ql_prim_rsz_vf(j, k, l, psi_idx))/(s_m - s_p)
4074
4075 flux_rsz_vf(j, k, l, psi_idx) = (hyper_cleaning_speed**2*(s_m*b%R(norm_dir) - s_p*b%L(norm_dir)) + s_m*s_p*(ql_prim_rsz_vf(j, k, l, psi_idx) - qr_prim_rsz_vf(j + 1, k, l, psi_idx)))/(s_m - s_p)
4076 else
4077 flux_rsz_vf(j, k, l, b_idx%beg + norm_dir - 1) = 0._wp ! Without hyperbolic cleaning, make sure flux of B_normal is identically zero
4078 end if
4079 end if
4080 flux_src_rsz_vf(j, k, l, advxb) = 0._wp
4081 end if
4082
4083# 1001 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4084
4085 end do
4086 end do
4087 end do
4088
4089# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4090
4091# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4092#if defined(MFC_OpenACC)
4093# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4094!$acc end parallel loop
4095# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4096#elif defined(MFC_OpenMP)
4097# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4098
4099# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4100
4101# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4102!$omp end target teams loop
4103# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4104#endif
4105# 1005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4106
4107 end if
4108
4109# 1009 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4110
4111 if (viscous .or. dummy) then
4112 if (weno_re_flux) then
4113
4114 call s_compute_viscous_source_flux( &
4115 ql_prim_vf(momxb:momxe), &
4116 dql_prim_dx_vf(momxb:momxe), &
4117 dql_prim_dy_vf(momxb:momxe), &
4118 dql_prim_dz_vf(momxb:momxe), &
4119 qr_prim_vf(momxb:momxe), &
4120 dqr_prim_dx_vf(momxb:momxe), &
4121 dqr_prim_dy_vf(momxb:momxe), &
4122 dqr_prim_dz_vf(momxb:momxe), &
4123 flux_src_vf, norm_dir, ix, iy, iz)
4124 else
4125 call s_compute_viscous_source_flux( &
4126 q_prim_vf(momxb:momxe), &
4127 dql_prim_dx_vf(momxb:momxe), &
4128 dql_prim_dy_vf(momxb:momxe), &
4129 dql_prim_dz_vf(momxb:momxe), &
4130 q_prim_vf(momxb:momxe), &
4131 dqr_prim_dx_vf(momxb:momxe), &
4132 dqr_prim_dy_vf(momxb:momxe), &
4133 dqr_prim_dz_vf(momxb:momxe), &
4134 flux_src_vf, norm_dir, ix, iy, iz)
4135 end if
4136 end if
4137
4138 call s_finalize_riemann_solver(flux_vf, flux_src_vf, &
4139 flux_gsrc_vf, &
4140 norm_dir)
4141
4142 end subroutine s_hll_riemann_solver
4143
4144 !> @brief Computes intercell fluxes using the Lax-Friedrichs (LF) approximate Riemann solver.
4145 subroutine s_lf_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, &
4146 dqL_prim_dy_vf, &
4147 dqL_prim_dz_vf, &
4148 qL_prim_vf, &
4149 qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, &
4150 dqR_prim_dy_vf, &
4151 dqR_prim_dz_vf, &
4152 qR_prim_vf, &
4153 q_prim_vf, &
4154 flux_vf, flux_src_vf, &
4155 flux_gsrc_vf, &
4156 norm_dir, ix, iy, iz)
4157
4158 real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(inout) :: ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf
4159 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
4160
4161 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
4162
4163 type(scalar_field), &
4164 allocatable, dimension(:), &
4165 intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, &
4166 dql_prim_dy_vf, dqr_prim_dy_vf, &
4167 dql_prim_dz_vf, dqr_prim_dz_vf
4168
4169 ! Intercell fluxes
4170 type(scalar_field), &
4171 dimension(sys_size), &
4172 intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
4173 real(wp) :: flux_tau_l, flux_tau_r
4174
4175 integer, intent(in) :: norm_dir
4176 type(int_bounds_info), intent(in) :: ix, iy, iz
4177# 1085 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4178 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
4179 real(wp), dimension(num_vels) :: vel_l, vel_r
4180 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
4181 real(wp), dimension(num_species) :: ys_l, ys_r
4182 real(wp), dimension(num_species) :: cp_il, cp_ir, xs_l, xs_r, gamma_il, gamma_ir
4183 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
4184 real(wp), dimension(num_dims, num_dims) :: vel_grad_l, vel_grad_r !< Averaged velocity gradient tensor `d(vel_i)/d(coord_j)`.
4185# 1093 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4186 real(wp) :: rho_l, rho_r
4187
4188 real(wp) :: pres_l, pres_r
4189 real(wp) :: e_l, e_r
4190 real(wp) :: h_l, h_r
4191 real(wp) :: cp_avg, cv_avg, t_avg, eps, c_sum_yi_phi
4192 real(wp) :: t_l, t_r
4193 real(wp) :: y_l, y_r
4194 real(wp) :: mw_l, mw_r
4195 real(wp) :: r_gas_l, r_gas_r
4196 real(wp) :: cp_l, cp_r
4197 real(wp) :: cv_l, cv_r
4198 real(wp) :: gamm_l, gamm_r
4199 real(wp) :: gamma_l, gamma_r
4200 real(wp) :: pi_inf_l, pi_inf_r
4201 real(wp) :: qv_l, qv_r
4202 real(wp) :: c_l, c_r
4203 real(wp), dimension(6) :: tau_e_l, tau_e_r
4204 real(wp) :: g_l, g_r
4205 real(wp), dimension(2) :: re_l, re_r
4206 real(wp), dimension(3) :: xi_field_l, xi_field_r
4207
4208 real(wp) :: rho_avg
4209 real(wp) :: h_avg
4210 real(wp) :: gamma_avg
4211 real(wp) :: c_avg
4212
4213 real(wp) :: s_l, s_r, s_m, s_p, s_s
4214 real(wp) :: xi_m, xi_p
4215
4216 real(wp) :: ptilde_l, ptilde_r
4217 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
4218 real(wp) :: vel_l_tmp, vel_r_tmp
4219 real(wp) :: ms_l, ms_r, pres_sl, pres_sr
4220 real(wp) :: alpha_l_sum, alpha_r_sum
4221 real(wp) :: zcoef, pcorr !< low Mach number correction
4222
4223 type(riemann_states) :: c_fast, pres_mag
4224 type(riemann_states_vec3) :: b
4225
4226 type(riemann_states) :: ga ! Gamma (Lorentz factor)
4227 type(riemann_states) :: vdotb, b2
4228 type(riemann_states_vec3) :: b4 ! 4-magnetic field components (spatial: b4x, b4y, b4z)
4229 type(riemann_states_vec3) :: cm ! Conservative momentum variables
4230
4231 integer :: i, j, k, l, q !< Generic loop iterators
4232 integer, dimension(3) :: idx_right_phys !< Physical (j,k,l) indices for right state.
4233
4234 ! Populating the buffers of the left and right Riemann problem
4235 ! states variables, based on the choice of boundary conditions
4236 call s_populate_riemann_states_variables_buffers( &
4237 ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
4238 dql_prim_dy_vf, &
4239 dql_prim_dz_vf, &
4240 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
4241 dqr_prim_dy_vf, &
4242 dqr_prim_dz_vf, &
4243 norm_dir, ix, iy, iz)
4244
4245 ! Reshaping inputted data based on dimensional splitting direction
4246 call s_initialize_riemann_solver( &
4247 flux_src_vf, &
4248 norm_dir)
4249# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4250
4251 if (norm_dir == 1) then
4252
4253# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4254
4255# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4256#if defined(MFC_OpenACC)
4257# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4258!$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)
4259# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4260#elif defined(MFC_OpenMP)
4261# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4262
4263# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4264
4265# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4266
4267# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4268!$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)
4269# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4270#endif
4271# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4272
4273 do l = is3%beg, is3%end
4274 do k = is2%beg, is2%end
4275 do j = is1%beg, is1%end
4276
4277# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4278#if defined(MFC_OpenACC)
4279# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4280!$acc loop seq
4281# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4282#elif defined(MFC_OpenMP)
4283# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4284
4285# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4286#endif
4287 do i = 1, contxe
4288 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
4289 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
4290 end do
4291
4292 vel_l_rms = 0._wp; vel_r_rms = 0._wp
4293
4294
4295# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4296#if defined(MFC_OpenACC)
4297# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4298!$acc loop seq
4299# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4300#elif defined(MFC_OpenMP)
4301# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4302
4303# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4304#endif
4305 do i = 1, num_vels
4306 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
4307 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
4308 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
4309 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
4310 end do
4311
4312
4313# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4314#if defined(MFC_OpenACC)
4315# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4316!$acc loop seq
4317# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4318#elif defined(MFC_OpenMP)
4319# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4320
4321# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4322#endif
4323 do i = 1, num_fluids
4324 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
4325 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
4326 end do
4327
4328 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
4329 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
4330
4331 if (mhd) then
4332 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
4333 b%L(1) = bx0
4334 b%R(1) = bx0
4335 b%L(2) = ql_prim_rsx_vf(j, k, l, b_idx%beg)
4336 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg)
4337 b%L(3) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)
4338 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 1)
4339 else ! 2D/3D: Bx, By, Bz as variables
4340 b%L(1) = ql_prim_rsx_vf(j, k, l, b_idx%beg)
4341 b%R(1) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg)
4342 b%L(2) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)
4343 b%R(2) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 1)
4344 b%L(3) = ql_prim_rsx_vf(j, k, l, b_idx%beg + 2)
4345 b%R(3) = qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 2)
4346 end if
4347 end if
4348
4349 rho_l = 0._wp
4350 gamma_l = 0._wp
4351 pi_inf_l = 0._wp
4352 qv_l = 0._wp
4353
4354 rho_r = 0._wp
4355 gamma_r = 0._wp
4356 pi_inf_r = 0._wp
4357 qv_r = 0._wp
4358
4359 alpha_l_sum = 0._wp
4360 alpha_r_sum = 0._wp
4361
4362 pres_mag%L = 0._wp
4363 pres_mag%R = 0._wp
4364
4365 if (mpp_lim) then
4366
4367# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4368#if defined(MFC_OpenACC)
4369# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4370!$acc loop seq
4371# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4372#elif defined(MFC_OpenMP)
4373# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4374
4375# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4376#endif
4377 do i = 1, num_fluids
4378 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
4379 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
4380 alpha_l_sum = alpha_l_sum + alpha_l(i)
4381 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
4382 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
4383 alpha_r_sum = alpha_r_sum + alpha_r(i)
4384 end do
4385
4386 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
4387 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
4388 end if
4389
4390
4391# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4392#if defined(MFC_OpenACC)
4393# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4394!$acc loop seq
4395# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4396#elif defined(MFC_OpenMP)
4397# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4398
4399# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4400#endif
4401 do i = 1, num_fluids
4402 rho_l = rho_l + alpha_rho_l(i)
4403 gamma_l = gamma_l + alpha_l(i)*gammas(i)
4404 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
4405 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
4406
4407 rho_r = rho_r + alpha_rho_r(i)
4408 gamma_r = gamma_r + alpha_r(i)*gammas(i)
4409 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
4410 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
4411 end do
4412
4413 if (viscous) then
4414
4415# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4416#if defined(MFC_OpenACC)
4417# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4418!$acc loop seq
4419# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4420#elif defined(MFC_OpenMP)
4421# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4422
4423# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4424#endif
4425 do i = 1, 2
4426 re_l(i) = dflt_real
4427 re_r(i) = dflt_real
4428
4429 if (re_size(i) > 0) re_l(i) = 0._wp
4430 if (re_size(i) > 0) re_r(i) = 0._wp
4431
4432
4433# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4434#if defined(MFC_OpenACC)
4435# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4436!$acc loop seq
4437# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4438#elif defined(MFC_OpenMP)
4439# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4440
4441# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4442#endif
4443 do q = 1, re_size(i)
4444 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
4445 + re_l(i)
4446 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
4447 + re_r(i)
4448 end do
4449
4450 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
4451 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
4452 end do
4453 end if
4454
4455 if (chemistry) then
4456
4457# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4458#if defined(MFC_OpenACC)
4459# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4460!$acc loop seq
4461# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4462#elif defined(MFC_OpenMP)
4463# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4464
4465# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4466#endif
4467 do i = chemxb, chemxe
4468 ys_l(i - chemxb + 1) = ql_prim_rsx_vf(j, k, l, i)
4469 ys_r(i - chemxb + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
4470 end do
4471
4472 call get_mixture_molecular_weight(ys_l, mw_l)
4473 call get_mixture_molecular_weight(ys_r, mw_r)
4474
4475# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4476 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
4477 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
4478# 1289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4479
4480 r_gas_l = gas_constant/mw_l
4481 r_gas_r = gas_constant/mw_r
4482 t_l = pres_l/rho_l/r_gas_l
4483 t_r = pres_r/rho_r/r_gas_r
4484
4485 call get_species_specific_heats_r(t_l, cp_il)
4486 call get_species_specific_heats_r(t_r, cp_ir)
4487
4488 if (chem_params%gamma_method == 1) then
4489 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
4490 gamma_il = cp_il/(cp_il - 1.0_wp)
4491 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
4492
4493 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
4494 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
4495 else if (chem_params%gamma_method == 2) then
4496 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
4497 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
4498 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
4499 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
4500 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
4501
4502 gamm_l = cp_l/cv_l
4503 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
4504 gamm_r = cp_r/cv_r
4505 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
4506 end if
4507
4508 call get_mixture_energy_mass(t_l, ys_l, e_l)
4509 call get_mixture_energy_mass(t_r, ys_r, e_r)
4510
4511 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
4512 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
4513 h_l = (e_l + pres_l)/rho_l
4514 h_r = (e_r + pres_r)/rho_r
4515 elseif (mhd .and. relativity) then
4516# 1327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4517 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
4518 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
4519 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
4520 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
4521
4522 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
4523 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
4524 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
4525 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
4526
4527 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
4528 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
4529
4530 ! Hard-coded EOS
4531 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
4532 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
4533
4534 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
4535 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
4536
4537 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
4538 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
4539# 1350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4540 elseif (mhd .and. .not. relativity) then
4541 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
4542 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
4543 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
4544 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R ! includes magnetic energy
4545 h_l = (e_l + pres_l - pres_mag%L)/rho_l
4546 h_r = (e_r + pres_r - pres_mag%R)/rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
4547 else
4548 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
4549 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
4550 h_l = (e_l + pres_l)/rho_l
4551 h_r = (e_r + pres_r)/rho_r
4552 end if
4553
4554 ! elastic energy update
4555 if (hypoelasticity) then
4556 g_l = 0._wp; g_r = 0._wp
4557
4558
4559# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4560#if defined(MFC_OpenACC)
4561# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4562!$acc loop seq
4563# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4564#elif defined(MFC_OpenMP)
4565# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4566
4567# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4568#endif
4569 do i = 1, num_fluids
4570 g_l = g_l + alpha_l(i)*gs_rs(i)
4571 g_r = g_r + alpha_r(i)*gs_rs(i)
4572 end do
4573
4574 if (cont_damage) then
4575 g_l = g_l*max((1._wp - ql_prim_rsx_vf(j, k, l, damage_idx)), 0._wp)
4576 g_r = g_r*max((1._wp - qr_prim_rsx_vf(j, k, l, damage_idx)), 0._wp)
4577 end if
4578
4579 do i = 1, strxe - strxb + 1
4580 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
4581 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
4582 ! Elastic contribution to energy if G large enough
4583 !TODO take out if statement if stable without
4584 if ((g_l > 1000) .and. (g_r > 1000)) then
4585 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4586 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4587 ! Double for shear stresses
4588 if (any(strxb - 1 + i == shear_indices)) then
4589 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
4590 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
4591 end if
4592 end if
4593 end do
4594 end if
4595
4596 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
4597 vel_l_rms, 0._wp, c_l, qv_l)
4598
4599 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
4600 vel_r_rms, 0._wp, c_r, qv_r)
4601
4602 if (mhd) then
4603 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
4604 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
4605 end if
4606
4607 s_l = 0._wp; s_r = 0._wp
4608
4609
4610# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4611#if defined(MFC_OpenACC)
4612# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4613!$acc loop seq
4614# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4615#elif defined(MFC_OpenMP)
4616# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4617
4618# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4619#endif
4620 do i = 1, num_dims
4621 s_l = s_l + vel_l(i)**2._wp
4622 s_r = s_r + vel_r(i)**2._wp
4623 end do
4624
4625 s_l = sqrt(s_l)
4626 s_r = sqrt(s_r)
4627
4628 s_p = max(s_l, s_r) + max(c_l, c_r)
4629 s_m = -s_p
4630
4631 s_l = s_m
4632 s_r = s_p
4633
4634 ! Low Mach correction
4635 if (low_mach == 1) then
4636
4637# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4638 if (riemann_solver == 1 .or. riemann_solver == 5) then
4639# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4640
4641# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4642 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4643# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4644 pcorr = 0._wp
4645# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4646
4647# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4648 if (low_mach == 1) then
4649# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4650 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
4651# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4652 end if
4653# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4654
4655# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4656 else if (riemann_solver == 2) then
4657# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4658 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
4659# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4660 pcorr = 0._wp
4661# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4662
4663# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4664 if (low_mach == 1) then
4665# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4666 pcorr = rho_l*rho_r* &
4667# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4668 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
4669# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4670 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
4671# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4672 (zcoef - 1._wp)
4673# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4674 else if (low_mach == 2) then
4675# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4676 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))))
4677# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4678 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))))
4679# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4680 vel_l(dir_idx(1)) = vel_l_tmp
4681# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4682 vel_r(dir_idx(1)) = vel_r_tmp
4683# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4684 end if
4685# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4686 end if
4687# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4688
4689 else
4690 pcorr = 0._wp
4691 end if
4692
4693 ! Mass
4694 if (.not. relativity) then
4695
4696# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4697#if defined(MFC_OpenACC)
4698# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4699!$acc loop seq
4700# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4701#elif defined(MFC_OpenMP)
4702# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4703
4704# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4705#endif
4706 do i = 1, contxe
4707 flux_rsx_vf(j, k, l, i) = &
4708 (s_m*alpha_rho_r(i)*vel_r(norm_dir) &
4709 - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
4710 + s_m*s_p*(alpha_rho_l(i) &
4711 - alpha_rho_r(i))) &
4712 /(s_m - s_p)
4713 end do
4714 elseif (relativity) then
4715
4716# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4717#if defined(MFC_OpenACC)
4718# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4719!$acc loop seq
4720# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4721#elif defined(MFC_OpenMP)
4722# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4723
4724# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4725#endif
4726 do i = 1, contxe
4727 flux_rsx_vf(j, k, l, i) = &
4728 (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) &
4729 - s_p*ga%L*alpha_rho_l(i)*vel_l(norm_dir) &
4730 + s_m*s_p*(ga%L*alpha_rho_l(i) &
4731 - ga%R*alpha_rho_r(i))) &
4732 /(s_m - s_p)
4733 end do
4734 end if
4735
4736 ! Momentum
4737 if (mhd .and. (.not. relativity)) then
4738
4739# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4740#if defined(MFC_OpenACC)
4741# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4742!$acc loop seq
4743# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4744#elif defined(MFC_OpenMP)
4745# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4746
4747# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4748#endif
4749 do i = 1, 3
4750 ! Flux of rho*v_i in the x direction
4751 ! = rho * v_i * v_x - B_i * B_x + delta_(x,i) * p_tot
4752 flux_rsx_vf(j, k, l, contxe + i) = &
4753 (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) &
4754 - b%R(i)*b%R(norm_dir) &
4755 + dir_flg(i)*(pres_r + pres_mag%R)) &
4756 - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
4757 - b%L(i)*b%L(norm_dir) &
4758 + dir_flg(i)*(pres_l + pres_mag%L)) &
4759 + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i))) &
4760 /(s_m - s_p)
4761 end do
4762 elseif (mhd .and. relativity) then
4763
4764# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4765#if defined(MFC_OpenACC)
4766# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4767!$acc loop seq
4768# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4769#elif defined(MFC_OpenMP)
4770# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4771
4772# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4773#endif
4774 do i = 1, 3
4775 ! Flux of m_i in the x direction
4776 ! = m_i * v_x - b_i/Gamma * B_x + delta_(x,i) * p_tot
4777 flux_rsx_vf(j, k, l, contxe + i) = &
4778 (s_m*(cm%R(i)*vel_r(norm_dir) &
4779 - b4%R(i)/ga%R*b%R(norm_dir) &
4780 + dir_flg(i)*(pres_r + pres_mag%R)) &
4781 - s_p*(cm%L(i)*vel_l(norm_dir) &
4782 - b4%L(i)/ga%L*b%L(norm_dir) &
4783 + dir_flg(i)*(pres_l + pres_mag%L)) &
4784 + s_m*s_p*(cm%L(i) - cm%R(i))) &
4785 /(s_m - s_p)
4786 end do
4787 elseif (bubbles_euler) then
4788
4789# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4790#if defined(MFC_OpenACC)
4791# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4792!$acc loop seq
4793# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4794#elif defined(MFC_OpenMP)
4795# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4796
4797# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4798#endif
4799 do i = 1, num_vels
4800 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
4801 (s_m*(rho_r*vel_r(dir_idx(1)) &
4802 *vel_r(dir_idx(i)) &
4803 + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
4804 - s_p*(rho_l*vel_l(dir_idx(1)) &
4805 *vel_l(dir_idx(i)) &
4806 + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
4807 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4808 - rho_r*vel_r(dir_idx(i)))) &
4809 /(s_m - s_p) &
4810 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4811 end do
4812 else if (hypoelasticity) then
4813
4814# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4815#if defined(MFC_OpenACC)
4816# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4817!$acc loop seq
4818# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4819#elif defined(MFC_OpenMP)
4820# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4821
4822# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4823#endif
4824 do i = 1, num_vels
4825 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
4826 (s_m*(rho_r*vel_r(dir_idx(1)) &
4827 *vel_r(dir_idx(i)) &
4828 + dir_flg(dir_idx(i))*pres_r &
4829 - tau_e_r(dir_idx_tau(i))) &
4830 - s_p*(rho_l*vel_l(dir_idx(1)) &
4831 *vel_l(dir_idx(i)) &
4832 + dir_flg(dir_idx(i))*pres_l &
4833 - tau_e_l(dir_idx_tau(i))) &
4834 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4835 - rho_r*vel_r(dir_idx(i)))) &
4836 /(s_m - s_p)
4837 end do
4838 else
4839
4840# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4841#if defined(MFC_OpenACC)
4842# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4843!$acc loop seq
4844# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4845#elif defined(MFC_OpenMP)
4846# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4847
4848# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4849#endif
4850 do i = 1, num_vels
4851 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
4852 (s_m*(rho_r*vel_r(dir_idx(1)) &
4853 *vel_r(dir_idx(i)) &
4854 + dir_flg(dir_idx(i))*pres_r) &
4855 - s_p*(rho_l*vel_l(dir_idx(1)) &
4856 *vel_l(dir_idx(i)) &
4857 + dir_flg(dir_idx(i))*pres_l) &
4858 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
4859 - rho_r*vel_r(dir_idx(i)))) &
4860 /(s_m - s_p) &
4861 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
4862 end do
4863 end if
4864
4865 ! Energy
4866 if (mhd .and. (.not. relativity)) then
4867 ! energy flux = (E + p + p_mag) * v_x - B_x * (v_x*B_x + v_y*B_y + v_z*B_z)
4868# 1537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4869 flux_rsx_vf(j, k, l, e_idx) = &
4870 (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir)*(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
4871 - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) &
4872 + s_m*s_p*(e_l - e_r)) &
4873 /(s_m - s_p)
4874# 1543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4875 elseif (mhd .and. relativity) then
4876 ! energy flux = m_x - mass flux
4877 ! Hard-coded for single-component for now
4878 flux_rsx_vf(j, k, l, e_idx) = &
4879 (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
4880 - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) &
4881 + s_m*s_p*(e_l - e_r)) &
4882 /(s_m - s_p)
4883 else if (bubbles_euler) then
4884 flux_rsx_vf(j, k, l, e_idx) = &
4885 (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
4886 - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) &
4887 + s_m*s_p*(e_l - e_r)) &
4888 /(s_m - s_p) &
4889 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
4890 else if (hypoelasticity) then
4891 flux_tau_l = 0._wp; flux_tau_r = 0._wp
4892
4893# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4894#if defined(MFC_OpenACC)
4895# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4896!$acc loop seq
4897# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4898#elif defined(MFC_OpenMP)
4899# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4900
4901# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4902#endif
4903 do i = 1, num_dims
4904 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
4905 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
4906 end do
4907 flux_rsx_vf(j, k, l, e_idx) = &
4908 (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
4909 - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) &
4910 + s_m*s_p*(e_l - e_r))/(s_m - s_p)
4911 else
4912 flux_rsx_vf(j, k, l, e_idx) = &
4913 (s_m*vel_r(dir_idx(1))*(e_r + pres_r) &
4914 - s_p*vel_l(dir_idx(1))*(e_l + pres_l) &
4915 + s_m*s_p*(e_l - e_r)) &
4916 /(s_m - s_p) &
4917 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
4918 end if
4919
4920 ! Elastic Stresses
4921 if (hypoelasticity) then
4922 do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow
4923 flux_rsx_vf(j, k, l, strxb - 1 + i) = &
4924 (s_m*(rho_r*vel_r(dir_idx(1)) &
4925 *tau_e_r(i)) &
4926 - s_p*(rho_l*vel_l(dir_idx(1)) &
4927 *tau_e_l(i)) &
4928 + s_m*s_p*(rho_l*tau_e_l(i) &
4929 - rho_r*tau_e_r(i))) &
4930 /(s_m - s_p)
4931 end do
4932 end if
4933
4934 ! Advection
4935
4936# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4937#if defined(MFC_OpenACC)
4938# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4939!$acc loop seq
4940# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4941#elif defined(MFC_OpenMP)
4942# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4943
4944# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4945#endif
4946 do i = advxb, advxe
4947 flux_rsx_vf(j, k, l, i) = &
4948 (ql_prim_rsx_vf(j, k, l, i) &
4949 - qr_prim_rsx_vf(j + 1, k, l, i)) &
4950 *s_m*s_p/(s_m - s_p)
4951 flux_src_rsx_vf(j, k, l, i) = &
4952 (s_m*qr_prim_rsx_vf(j + 1, k, l, i) &
4953 - s_p*ql_prim_rsx_vf(j, k, l, i)) &
4954 /(s_m - s_p)
4955 end do
4956
4957 if (bubbles_euler) then
4958 ! From HLLC: Kills mass transport @ bubble gas density
4959 if (num_fluids > 1) then
4960 flux_rsx_vf(j, k, l, contxe) = 0._wp
4961 end if
4962 end if
4963
4964 if (chemistry) then
4965
4966# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4967#if defined(MFC_OpenACC)
4968# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4969!$acc loop seq
4970# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4971#elif defined(MFC_OpenMP)
4972# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4973
4974# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4975#endif
4976 do i = chemxb, chemxe
4977 y_l = ql_prim_rsx_vf(j, k, l, i)
4978 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
4979
4980 flux_rsx_vf(j, k, l, i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) &
4981 - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
4982 + s_m*s_p*(y_l*rho_l - y_r*rho_r)) &
4983 /(s_m - s_p)
4984 flux_src_rsx_vf(j, k, l, i) = 0._wp
4985 end do
4986 end if
4987
4988 if (mhd) then
4989 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
4990 ! B_y flux = v_x * B_y - v_y * Bx0
4991 ! B_z flux = v_x * B_z - v_z * Bx0
4992
4993# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4994#if defined(MFC_OpenACC)
4995# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4996!$acc loop seq
4997# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
4998#elif defined(MFC_OpenMP)
4999# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5000
5001# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5002#endif
5003 do i = 0, 1
5004 flux_rsx_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
5005 - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) &
5006 + s_m*s_p*(b%L(2 + i) - b%R(2 + i)))/(s_m - s_p)
5007 end do
5008 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
5009 ! B_x d/dx flux = (1 - delta(x,x)) * (v_x * B_x - v_x * B_x)
5010 ! B_y d/dx flux = (1 - delta(y,x)) * (v_x * B_y - v_y * B_x)
5011 ! B_z d/dx flux = (1 - delta(z,x)) * (v_x * B_z - v_z * B_x)
5012
5013# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5014#if defined(MFC_OpenACC)
5015# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5016!$acc loop seq
5017# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5018#elif defined(MFC_OpenMP)
5019# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5020
5021# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5022#endif
5023 do i = 0, 2
5024 flux_rsx_vf(j, k, l, b_idx%beg + i) = (1 - dir_flg(i + 1))*( &
5025 s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1)*b%R(norm_dir)) - &
5026 s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + &
5027 s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
5028 end do
5029 end if
5030 flux_src_rsx_vf(j, k, l, advxb) = 0._wp
5031 end if
5032
5033# 1682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5034 end do
5035 end do
5036 end do
5037
5038# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5039
5040# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5041#if defined(MFC_OpenACC)
5042# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5043!$acc end parallel loop
5044# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5045#elif defined(MFC_OpenMP)
5046# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5047
5048# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5049
5050# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5051!$omp end target teams loop
5052# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5053#endif
5054# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5055
5056 end if
5057
5058# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5059
5060 if (norm_dir == 2) then
5061
5062# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5063
5064# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5065#if defined(MFC_OpenACC)
5066# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5067!$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)
5068# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5069#elif defined(MFC_OpenMP)
5070# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5071
5072# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5073
5074# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5075
5076# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5077!$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)
5078# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5079#endif
5080# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5081
5082 do l = is3%beg, is3%end
5083 do k = is2%beg, is2%end
5084 do j = is1%beg, is1%end
5085
5086# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5087#if defined(MFC_OpenACC)
5088# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5089!$acc loop seq
5090# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5091#elif defined(MFC_OpenMP)
5092# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5093
5094# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5095#endif
5096 do i = 1, contxe
5097 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
5098 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
5099 end do
5100
5101 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5102
5103
5104# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5105#if defined(MFC_OpenACC)
5106# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5107!$acc loop seq
5108# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5109#elif defined(MFC_OpenMP)
5110# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5111
5112# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5113#endif
5114 do i = 1, num_vels
5115 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
5116 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
5117 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5118 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5119 end do
5120
5121
5122# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5123#if defined(MFC_OpenACC)
5124# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5125!$acc loop seq
5126# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5127#elif defined(MFC_OpenMP)
5128# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5129
5130# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5131#endif
5132 do i = 1, num_fluids
5133 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
5134 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
5135 end do
5136
5137 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
5138 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
5139
5140 if (mhd) then
5141 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
5142 b%L(1) = bx0
5143 b%R(1) = bx0
5144 b%L(2) = ql_prim_rsy_vf(j, k, l, b_idx%beg)
5145 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg)
5146 b%L(3) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)
5147 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 1)
5148 else ! 2D/3D: Bx, By, Bz as variables
5149 b%L(1) = ql_prim_rsy_vf(j, k, l, b_idx%beg)
5150 b%R(1) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg)
5151 b%L(2) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)
5152 b%R(2) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 1)
5153 b%L(3) = ql_prim_rsy_vf(j, k, l, b_idx%beg + 2)
5154 b%R(3) = qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 2)
5155 end if
5156 end if
5157
5158 rho_l = 0._wp
5159 gamma_l = 0._wp
5160 pi_inf_l = 0._wp
5161 qv_l = 0._wp
5162
5163 rho_r = 0._wp
5164 gamma_r = 0._wp
5165 pi_inf_r = 0._wp
5166 qv_r = 0._wp
5167
5168 alpha_l_sum = 0._wp
5169 alpha_r_sum = 0._wp
5170
5171 pres_mag%L = 0._wp
5172 pres_mag%R = 0._wp
5173
5174 if (mpp_lim) then
5175
5176# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5177#if defined(MFC_OpenACC)
5178# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5179!$acc loop seq
5180# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5181#elif defined(MFC_OpenMP)
5182# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5183
5184# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5185#endif
5186 do i = 1, num_fluids
5187 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
5188 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
5189 alpha_l_sum = alpha_l_sum + alpha_l(i)
5190 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
5191 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
5192 alpha_r_sum = alpha_r_sum + alpha_r(i)
5193 end do
5194
5195 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
5196 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
5197 end if
5198
5199
5200# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5201#if defined(MFC_OpenACC)
5202# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5203!$acc loop seq
5204# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5205#elif defined(MFC_OpenMP)
5206# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5207
5208# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5209#endif
5210 do i = 1, num_fluids
5211 rho_l = rho_l + alpha_rho_l(i)
5212 gamma_l = gamma_l + alpha_l(i)*gammas(i)
5213 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
5214 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
5215
5216 rho_r = rho_r + alpha_rho_r(i)
5217 gamma_r = gamma_r + alpha_r(i)*gammas(i)
5218 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
5219 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
5220 end do
5221
5222 if (viscous) then
5223
5224# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5225#if defined(MFC_OpenACC)
5226# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5227!$acc loop seq
5228# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5229#elif defined(MFC_OpenMP)
5230# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5231
5232# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5233#endif
5234 do i = 1, 2
5235 re_l(i) = dflt_real
5236 re_r(i) = dflt_real
5237
5238 if (re_size(i) > 0) re_l(i) = 0._wp
5239 if (re_size(i) > 0) re_r(i) = 0._wp
5240
5241
5242# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5243#if defined(MFC_OpenACC)
5244# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5245!$acc loop seq
5246# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5247#elif defined(MFC_OpenMP)
5248# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5249
5250# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5251#endif
5252 do q = 1, re_size(i)
5253 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
5254 + re_l(i)
5255 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
5256 + re_r(i)
5257 end do
5258
5259 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
5260 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
5261 end do
5262 end if
5263
5264 if (chemistry) then
5265
5266# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5267#if defined(MFC_OpenACC)
5268# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5269!$acc loop seq
5270# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5271#elif defined(MFC_OpenMP)
5272# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5273
5274# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5275#endif
5276 do i = chemxb, chemxe
5277 ys_l(i - chemxb + 1) = ql_prim_rsy_vf(j, k, l, i)
5278 ys_r(i - chemxb + 1) = qr_prim_rsy_vf(j + 1, k, l, i)
5279 end do
5280
5281 call get_mixture_molecular_weight(ys_l, mw_l)
5282 call get_mixture_molecular_weight(ys_r, mw_r)
5283
5284# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5285 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
5286 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
5287# 1289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5288
5289 r_gas_l = gas_constant/mw_l
5290 r_gas_r = gas_constant/mw_r
5291 t_l = pres_l/rho_l/r_gas_l
5292 t_r = pres_r/rho_r/r_gas_r
5293
5294 call get_species_specific_heats_r(t_l, cp_il)
5295 call get_species_specific_heats_r(t_r, cp_ir)
5296
5297 if (chem_params%gamma_method == 1) then
5298 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
5299 gamma_il = cp_il/(cp_il - 1.0_wp)
5300 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
5301
5302 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
5303 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
5304 else if (chem_params%gamma_method == 2) then
5305 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
5306 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
5307 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
5308 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
5309 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
5310
5311 gamm_l = cp_l/cv_l
5312 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
5313 gamm_r = cp_r/cv_r
5314 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
5315 end if
5316
5317 call get_mixture_energy_mass(t_l, ys_l, e_l)
5318 call get_mixture_energy_mass(t_r, ys_r, e_r)
5319
5320 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
5321 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
5322 h_l = (e_l + pres_l)/rho_l
5323 h_r = (e_r + pres_r)/rho_r
5324 elseif (mhd .and. relativity) then
5325# 1327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5326 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
5327 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
5328 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
5329 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
5330
5331 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
5332 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
5333 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
5334 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
5335
5336 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
5337 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
5338
5339 ! Hard-coded EOS
5340 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
5341 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
5342
5343 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
5344 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
5345
5346 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
5347 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
5348# 1350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5349 elseif (mhd .and. .not. relativity) then
5350 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
5351 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
5352 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
5353 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R ! includes magnetic energy
5354 h_l = (e_l + pres_l - pres_mag%L)/rho_l
5355 h_r = (e_r + pres_r - pres_mag%R)/rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
5356 else
5357 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
5358 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
5359 h_l = (e_l + pres_l)/rho_l
5360 h_r = (e_r + pres_r)/rho_r
5361 end if
5362
5363 ! elastic energy update
5364 if (hypoelasticity) then
5365 g_l = 0._wp; g_r = 0._wp
5366
5367
5368# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5369#if defined(MFC_OpenACC)
5370# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5371!$acc loop seq
5372# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5373#elif defined(MFC_OpenMP)
5374# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5375
5376# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5377#endif
5378 do i = 1, num_fluids
5379 g_l = g_l + alpha_l(i)*gs_rs(i)
5380 g_r = g_r + alpha_r(i)*gs_rs(i)
5381 end do
5382
5383 if (cont_damage) then
5384 g_l = g_l*max((1._wp - ql_prim_rsy_vf(j, k, l, damage_idx)), 0._wp)
5385 g_r = g_r*max((1._wp - qr_prim_rsy_vf(j, k, l, damage_idx)), 0._wp)
5386 end if
5387
5388 do i = 1, strxe - strxb + 1
5389 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
5390 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
5391 ! Elastic contribution to energy if G large enough
5392 !TODO take out if statement if stable without
5393 if ((g_l > 1000) .and. (g_r > 1000)) then
5394 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5395 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5396 ! Double for shear stresses
5397 if (any(strxb - 1 + i == shear_indices)) then
5398 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
5399 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
5400 end if
5401 end if
5402 end do
5403 end if
5404
5405 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
5406 vel_l_rms, 0._wp, c_l, qv_l)
5407
5408 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
5409 vel_r_rms, 0._wp, c_r, qv_r)
5410
5411 if (mhd) then
5412 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
5413 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
5414 end if
5415
5416 s_l = 0._wp; s_r = 0._wp
5417
5418
5419# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5420#if defined(MFC_OpenACC)
5421# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5422!$acc loop seq
5423# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5424#elif defined(MFC_OpenMP)
5425# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5426
5427# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5428#endif
5429 do i = 1, num_dims
5430 s_l = s_l + vel_l(i)**2._wp
5431 s_r = s_r + vel_r(i)**2._wp
5432 end do
5433
5434 s_l = sqrt(s_l)
5435 s_r = sqrt(s_r)
5436
5437 s_p = max(s_l, s_r) + max(c_l, c_r)
5438 s_m = -s_p
5439
5440 s_l = s_m
5441 s_r = s_p
5442
5443 ! Low Mach correction
5444 if (low_mach == 1) then
5445
5446# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5447 if (riemann_solver == 1 .or. riemann_solver == 5) then
5448# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5449
5450# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5451 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5452# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5453 pcorr = 0._wp
5454# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5455
5456# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5457 if (low_mach == 1) then
5458# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5459 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
5460# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5461 end if
5462# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5463
5464# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5465 else if (riemann_solver == 2) then
5466# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5467 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
5468# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5469 pcorr = 0._wp
5470# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5471
5472# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5473 if (low_mach == 1) then
5474# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5475 pcorr = rho_l*rho_r* &
5476# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5477 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
5478# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5479 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
5480# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5481 (zcoef - 1._wp)
5482# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5483 else if (low_mach == 2) then
5484# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5485 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))))
5486# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5487 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))))
5488# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5489 vel_l(dir_idx(1)) = vel_l_tmp
5490# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5491 vel_r(dir_idx(1)) = vel_r_tmp
5492# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5493 end if
5494# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5495 end if
5496# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5497
5498 else
5499 pcorr = 0._wp
5500 end if
5501
5502 ! Mass
5503 if (.not. relativity) then
5504
5505# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5506#if defined(MFC_OpenACC)
5507# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5508!$acc loop seq
5509# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5510#elif defined(MFC_OpenMP)
5511# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5512
5513# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5514#endif
5515 do i = 1, contxe
5516 flux_rsy_vf(j, k, l, i) = &
5517 (s_m*alpha_rho_r(i)*vel_r(norm_dir) &
5518 - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
5519 + s_m*s_p*(alpha_rho_l(i) &
5520 - alpha_rho_r(i))) &
5521 /(s_m - s_p)
5522 end do
5523 elseif (relativity) then
5524
5525# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5526#if defined(MFC_OpenACC)
5527# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5528!$acc loop seq
5529# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5530#elif defined(MFC_OpenMP)
5531# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5532
5533# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5534#endif
5535 do i = 1, contxe
5536 flux_rsy_vf(j, k, l, i) = &
5537 (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) &
5538 - s_p*ga%L*alpha_rho_l(i)*vel_l(norm_dir) &
5539 + s_m*s_p*(ga%L*alpha_rho_l(i) &
5540 - ga%R*alpha_rho_r(i))) &
5541 /(s_m - s_p)
5542 end do
5543 end if
5544
5545 ! Momentum
5546 if (mhd .and. (.not. relativity)) then
5547
5548# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5549#if defined(MFC_OpenACC)
5550# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5551!$acc loop seq
5552# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5553#elif defined(MFC_OpenMP)
5554# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5555
5556# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5557#endif
5558 do i = 1, 3
5559 ! Flux of rho*v_i in the y direction
5560 ! = rho * v_i * v_y - B_i * B_y + delta_(y,i) * p_tot
5561 flux_rsy_vf(j, k, l, contxe + i) = &
5562 (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) &
5563 - b%R(i)*b%R(norm_dir) &
5564 + dir_flg(i)*(pres_r + pres_mag%R)) &
5565 - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
5566 - b%L(i)*b%L(norm_dir) &
5567 + dir_flg(i)*(pres_l + pres_mag%L)) &
5568 + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i))) &
5569 /(s_m - s_p)
5570 end do
5571 elseif (mhd .and. relativity) then
5572
5573# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5574#if defined(MFC_OpenACC)
5575# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5576!$acc loop seq
5577# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5578#elif defined(MFC_OpenMP)
5579# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5580
5581# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5582#endif
5583 do i = 1, 3
5584 ! Flux of m_i in the y direction
5585 ! = m_i * v_y - b_i/Gamma * B_y + delta_(y,i) * p_tot
5586 flux_rsy_vf(j, k, l, contxe + i) = &
5587 (s_m*(cm%R(i)*vel_r(norm_dir) &
5588 - b4%R(i)/ga%R*b%R(norm_dir) &
5589 + dir_flg(i)*(pres_r + pres_mag%R)) &
5590 - s_p*(cm%L(i)*vel_l(norm_dir) &
5591 - b4%L(i)/ga%L*b%L(norm_dir) &
5592 + dir_flg(i)*(pres_l + pres_mag%L)) &
5593 + s_m*s_p*(cm%L(i) - cm%R(i))) &
5594 /(s_m - s_p)
5595 end do
5596 elseif (bubbles_euler) then
5597
5598# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5599#if defined(MFC_OpenACC)
5600# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5601!$acc loop seq
5602# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5603#elif defined(MFC_OpenMP)
5604# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5605
5606# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5607#endif
5608 do i = 1, num_vels
5609 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
5610 (s_m*(rho_r*vel_r(dir_idx(1)) &
5611 *vel_r(dir_idx(i)) &
5612 + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
5613 - s_p*(rho_l*vel_l(dir_idx(1)) &
5614 *vel_l(dir_idx(i)) &
5615 + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
5616 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5617 - rho_r*vel_r(dir_idx(i)))) &
5618 /(s_m - s_p) &
5619 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5620 end do
5621 else if (hypoelasticity) then
5622
5623# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5624#if defined(MFC_OpenACC)
5625# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5626!$acc loop seq
5627# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5628#elif defined(MFC_OpenMP)
5629# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5630
5631# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5632#endif
5633 do i = 1, num_vels
5634 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
5635 (s_m*(rho_r*vel_r(dir_idx(1)) &
5636 *vel_r(dir_idx(i)) &
5637 + dir_flg(dir_idx(i))*pres_r &
5638 - tau_e_r(dir_idx_tau(i))) &
5639 - s_p*(rho_l*vel_l(dir_idx(1)) &
5640 *vel_l(dir_idx(i)) &
5641 + dir_flg(dir_idx(i))*pres_l &
5642 - tau_e_l(dir_idx_tau(i))) &
5643 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5644 - rho_r*vel_r(dir_idx(i)))) &
5645 /(s_m - s_p)
5646 end do
5647 else
5648
5649# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5650#if defined(MFC_OpenACC)
5651# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5652!$acc loop seq
5653# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5654#elif defined(MFC_OpenMP)
5655# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5656
5657# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5658#endif
5659 do i = 1, num_vels
5660 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
5661 (s_m*(rho_r*vel_r(dir_idx(1)) &
5662 *vel_r(dir_idx(i)) &
5663 + dir_flg(dir_idx(i))*pres_r) &
5664 - s_p*(rho_l*vel_l(dir_idx(1)) &
5665 *vel_l(dir_idx(i)) &
5666 + dir_flg(dir_idx(i))*pres_l) &
5667 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
5668 - rho_r*vel_r(dir_idx(i)))) &
5669 /(s_m - s_p) &
5670 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
5671 end do
5672 end if
5673
5674 ! Energy
5675 if (mhd .and. (.not. relativity)) then
5676 ! energy flux = (E + p + p_mag) * v_y - B_y * (v_x*B_x + v_y*B_y + v_z*B_z)
5677# 1537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5678 flux_rsy_vf(j, k, l, e_idx) = &
5679 (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir)*(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
5680 - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) &
5681 + s_m*s_p*(e_l - e_r)) &
5682 /(s_m - s_p)
5683# 1543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5684 elseif (mhd .and. relativity) then
5685 ! energy flux = m_y - mass flux
5686 ! Hard-coded for single-component for now
5687 flux_rsy_vf(j, k, l, e_idx) = &
5688 (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
5689 - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) &
5690 + s_m*s_p*(e_l - e_r)) &
5691 /(s_m - s_p)
5692 else if (bubbles_euler) then
5693 flux_rsy_vf(j, k, l, e_idx) = &
5694 (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
5695 - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) &
5696 + s_m*s_p*(e_l - e_r)) &
5697 /(s_m - s_p) &
5698 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
5699 else if (hypoelasticity) then
5700 flux_tau_l = 0._wp; flux_tau_r = 0._wp
5701
5702# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5703#if defined(MFC_OpenACC)
5704# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5705!$acc loop seq
5706# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5707#elif defined(MFC_OpenMP)
5708# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5709
5710# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5711#endif
5712 do i = 1, num_dims
5713 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
5714 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
5715 end do
5716 flux_rsy_vf(j, k, l, e_idx) = &
5717 (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
5718 - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) &
5719 + s_m*s_p*(e_l - e_r))/(s_m - s_p)
5720 else
5721 flux_rsy_vf(j, k, l, e_idx) = &
5722 (s_m*vel_r(dir_idx(1))*(e_r + pres_r) &
5723 - s_p*vel_l(dir_idx(1))*(e_l + pres_l) &
5724 + s_m*s_p*(e_l - e_r)) &
5725 /(s_m - s_p) &
5726 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
5727 end if
5728
5729 ! Elastic Stresses
5730 if (hypoelasticity) then
5731 do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow
5732 flux_rsy_vf(j, k, l, strxb - 1 + i) = &
5733 (s_m*(rho_r*vel_r(dir_idx(1)) &
5734 *tau_e_r(i)) &
5735 - s_p*(rho_l*vel_l(dir_idx(1)) &
5736 *tau_e_l(i)) &
5737 + s_m*s_p*(rho_l*tau_e_l(i) &
5738 - rho_r*tau_e_r(i))) &
5739 /(s_m - s_p)
5740 end do
5741 end if
5742
5743 ! Advection
5744
5745# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5746#if defined(MFC_OpenACC)
5747# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5748!$acc loop seq
5749# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5750#elif defined(MFC_OpenMP)
5751# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5752
5753# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5754#endif
5755 do i = advxb, advxe
5756 flux_rsy_vf(j, k, l, i) = &
5757 (ql_prim_rsy_vf(j, k, l, i) &
5758 - qr_prim_rsy_vf(j + 1, k, l, i)) &
5759 *s_m*s_p/(s_m - s_p)
5760 flux_src_rsy_vf(j, k, l, i) = &
5761 (s_m*qr_prim_rsy_vf(j + 1, k, l, i) &
5762 - s_p*ql_prim_rsy_vf(j, k, l, i)) &
5763 /(s_m - s_p)
5764 end do
5765
5766 if (bubbles_euler) then
5767 ! From HLLC: Kills mass transport @ bubble gas density
5768 if (num_fluids > 1) then
5769 flux_rsy_vf(j, k, l, contxe) = 0._wp
5770 end if
5771 end if
5772
5773 if (chemistry) then
5774
5775# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5776#if defined(MFC_OpenACC)
5777# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5778!$acc loop seq
5779# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5780#elif defined(MFC_OpenMP)
5781# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5782
5783# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5784#endif
5785 do i = chemxb, chemxe
5786 y_l = ql_prim_rsy_vf(j, k, l, i)
5787 y_r = qr_prim_rsy_vf(j + 1, k, l, i)
5788
5789 flux_rsy_vf(j, k, l, i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) &
5790 - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
5791 + s_m*s_p*(y_l*rho_l - y_r*rho_r)) &
5792 /(s_m - s_p)
5793 flux_src_rsy_vf(j, k, l, i) = 0._wp
5794 end do
5795 end if
5796
5797 if (mhd) then
5798 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
5799 ! B_y flux = v_x * B_y - v_y * Bx0
5800 ! B_z flux = v_x * B_z - v_z * Bx0
5801
5802# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5803#if defined(MFC_OpenACC)
5804# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5805!$acc loop seq
5806# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5807#elif defined(MFC_OpenMP)
5808# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5809
5810# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5811#endif
5812 do i = 0, 1
5813 flux_rsx_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
5814 - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) &
5815 + s_m*s_p*(b%L(2 + i) - b%R(2 + i)))/(s_m - s_p)
5816 end do
5817 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
5818 ! B_x d/dy flux = (1 - delta(x,y)) * (v_y * B_x - v_x * B_y)
5819 ! B_y d/dy flux = (1 - delta(y,y)) * (v_y * B_y - v_y * B_y)
5820 ! B_z d/dy flux = (1 - delta(z,y)) * (v_y * B_z - v_z * B_y)
5821
5822# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5823#if defined(MFC_OpenACC)
5824# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5825!$acc loop seq
5826# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5827#elif defined(MFC_OpenMP)
5828# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5829
5830# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5831#endif
5832 do i = 0, 2
5833 flux_rsy_vf(j, k, l, b_idx%beg + i) = (1 - dir_flg(i + 1))*( &
5834 s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1)*b%R(norm_dir)) - &
5835 s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + &
5836 s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
5837 end do
5838 end if
5839 flux_src_rsy_vf(j, k, l, advxb) = 0._wp
5840 end if
5841
5842# 1652 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5843 if (cyl_coord) then
5844 !Substituting the advective flux into the inviscid geometrical source flux
5845
5846# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5847#if defined(MFC_OpenACC)
5848# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5849!$acc loop seq
5850# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5851#elif defined(MFC_OpenMP)
5852# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5853
5854# 1654 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5855#endif
5856 do i = 1, e_idx
5857 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
5858 end do
5859 ! Recalculating the radial momentum geometric source flux
5860 flux_gsrc_rsy_vf(j, k, l, contxe + 2) = &
5861 flux_rsy_vf(j, k, l, contxe + 2) &
5862 - (s_m*pres_r - s_p*pres_l)/(s_m - s_p)
5863 ! Geometrical source of the void fraction(s) is zero
5864
5865# 1663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5866#if defined(MFC_OpenACC)
5867# 1663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5868!$acc loop seq
5869# 1663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5870#elif defined(MFC_OpenMP)
5871# 1663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5872
5873# 1663 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5874#endif
5875 do i = advxb, advxe
5876 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
5877 end do
5878 end if
5879
5880 if (cyl_coord .and. hypoelasticity) then
5881 ! += tau_sigmasigma using HLL
5882 flux_gsrc_rsy_vf(j, k, l, contxe + 2) = &
5883 flux_gsrc_rsy_vf(j, k, l, contxe + 2) + &
5884 (s_m*tau_e_r(4) - s_p*tau_e_l(4)) &
5885 /(s_m - s_p)
5886
5887
5888# 1676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5889#if defined(MFC_OpenACC)
5890# 1676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5891!$acc loop seq
5892# 1676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5893#elif defined(MFC_OpenMP)
5894# 1676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5895
5896# 1676 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5897#endif
5898 do i = strxb, strxe
5899 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
5900 end do
5901 end if
5902# 1682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5903 end do
5904 end do
5905 end do
5906
5907# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5908
5909# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5910#if defined(MFC_OpenACC)
5911# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5912!$acc end parallel loop
5913# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5914#elif defined(MFC_OpenMP)
5915# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5916
5917# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5918
5919# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5920!$omp end target teams loop
5921# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5922#endif
5923# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5924
5925 end if
5926
5927# 1157 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5928
5929 if (norm_dir == 3) then
5930
5931# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5932
5933# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5934#if defined(MFC_OpenACC)
5935# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5936!$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)
5937# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5938#elif defined(MFC_OpenMP)
5939# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5940
5941# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5942
5943# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5944
5945# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5946!$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)
5947# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5948#endif
5949# 1159 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5950
5951 do l = is3%beg, is3%end
5952 do k = is2%beg, is2%end
5953 do j = is1%beg, is1%end
5954
5955# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5956#if defined(MFC_OpenACC)
5957# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5958!$acc loop seq
5959# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5960#elif defined(MFC_OpenMP)
5961# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5962
5963# 1163 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5964#endif
5965 do i = 1, contxe
5966 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
5967 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
5968 end do
5969
5970 vel_l_rms = 0._wp; vel_r_rms = 0._wp
5971
5972
5973# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5974#if defined(MFC_OpenACC)
5975# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5976!$acc loop seq
5977# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5978#elif defined(MFC_OpenMP)
5979# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5980
5981# 1171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5982#endif
5983 do i = 1, num_vels
5984 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
5985 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
5986 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
5987 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
5988 end do
5989
5990
5991# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5992#if defined(MFC_OpenACC)
5993# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5994!$acc loop seq
5995# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5996#elif defined(MFC_OpenMP)
5997# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
5998
5999# 1179 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6000#endif
6001 do i = 1, num_fluids
6002 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
6003 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
6004 end do
6005
6006 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
6007 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
6008
6009 if (mhd) then
6010 if (n == 0) then ! 1D: constant Bx; By, Bz as variables
6011 b%L(1) = bx0
6012 b%R(1) = bx0
6013 b%L(2) = ql_prim_rsz_vf(j, k, l, b_idx%beg)
6014 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg)
6015 b%L(3) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)
6016 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 1)
6017 else ! 2D/3D: Bx, By, Bz as variables
6018 b%L(1) = ql_prim_rsz_vf(j, k, l, b_idx%beg)
6019 b%R(1) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg)
6020 b%L(2) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)
6021 b%R(2) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 1)
6022 b%L(3) = ql_prim_rsz_vf(j, k, l, b_idx%beg + 2)
6023 b%R(3) = qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 2)
6024 end if
6025 end if
6026
6027 rho_l = 0._wp
6028 gamma_l = 0._wp
6029 pi_inf_l = 0._wp
6030 qv_l = 0._wp
6031
6032 rho_r = 0._wp
6033 gamma_r = 0._wp
6034 pi_inf_r = 0._wp
6035 qv_r = 0._wp
6036
6037 alpha_l_sum = 0._wp
6038 alpha_r_sum = 0._wp
6039
6040 pres_mag%L = 0._wp
6041 pres_mag%R = 0._wp
6042
6043 if (mpp_lim) then
6044
6045# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6046#if defined(MFC_OpenACC)
6047# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6048!$acc loop seq
6049# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6050#elif defined(MFC_OpenMP)
6051# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6052
6053# 1223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6054#endif
6055 do i = 1, num_fluids
6056 alpha_rho_l(i) = max(0._wp, alpha_rho_l(i))
6057 alpha_l(i) = min(max(0._wp, alpha_l(i)), 1._wp)
6058 alpha_l_sum = alpha_l_sum + alpha_l(i)
6059 alpha_rho_r(i) = max(0._wp, alpha_rho_r(i))
6060 alpha_r(i) = min(max(0._wp, alpha_r(i)), 1._wp)
6061 alpha_r_sum = alpha_r_sum + alpha_r(i)
6062 end do
6063
6064 alpha_l = alpha_l/max(alpha_l_sum, sgm_eps)
6065 alpha_r = alpha_r/max(alpha_r_sum, sgm_eps)
6066 end if
6067
6068
6069# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6070#if defined(MFC_OpenACC)
6071# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6072!$acc loop seq
6073# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6074#elif defined(MFC_OpenMP)
6075# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6076
6077# 1237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6078#endif
6079 do i = 1, num_fluids
6080 rho_l = rho_l + alpha_rho_l(i)
6081 gamma_l = gamma_l + alpha_l(i)*gammas(i)
6082 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
6083 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
6084
6085 rho_r = rho_r + alpha_rho_r(i)
6086 gamma_r = gamma_r + alpha_r(i)*gammas(i)
6087 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
6088 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
6089 end do
6090
6091 if (viscous) then
6092
6093# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6094#if defined(MFC_OpenACC)
6095# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6096!$acc loop seq
6097# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6098#elif defined(MFC_OpenMP)
6099# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6100
6101# 1251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6102#endif
6103 do i = 1, 2
6104 re_l(i) = dflt_real
6105 re_r(i) = dflt_real
6106
6107 if (re_size(i) > 0) re_l(i) = 0._wp
6108 if (re_size(i) > 0) re_r(i) = 0._wp
6109
6110
6111# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6112#if defined(MFC_OpenACC)
6113# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6114!$acc loop seq
6115# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6116#elif defined(MFC_OpenMP)
6117# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6118
6119# 1259 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6120#endif
6121 do q = 1, re_size(i)
6122 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
6123 + re_l(i)
6124 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
6125 + re_r(i)
6126 end do
6127
6128 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6129 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6130 end do
6131 end if
6132
6133 if (chemistry) then
6134
6135# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6136#if defined(MFC_OpenACC)
6137# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6138!$acc loop seq
6139# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6140#elif defined(MFC_OpenMP)
6141# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6142
6143# 1273 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6144#endif
6145 do i = chemxb, chemxe
6146 ys_l(i - chemxb + 1) = ql_prim_rsz_vf(j, k, l, i)
6147 ys_r(i - chemxb + 1) = qr_prim_rsz_vf(j + 1, k, l, i)
6148 end do
6149
6150 call get_mixture_molecular_weight(ys_l, mw_l)
6151 call get_mixture_molecular_weight(ys_r, mw_r)
6152
6153# 1286 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6154 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
6155 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
6156# 1289 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6157
6158 r_gas_l = gas_constant/mw_l
6159 r_gas_r = gas_constant/mw_r
6160 t_l = pres_l/rho_l/r_gas_l
6161 t_r = pres_r/rho_r/r_gas_r
6162
6163 call get_species_specific_heats_r(t_l, cp_il)
6164 call get_species_specific_heats_r(t_r, cp_ir)
6165
6166 if (chem_params%gamma_method == 1) then
6167 ! gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
6168 gamma_il = cp_il/(cp_il - 1.0_wp)
6169 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
6170
6171 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
6172 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
6173 else if (chem_params%gamma_method == 2) then
6174 ! gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
6175 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
6176 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
6177 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
6178 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
6179
6180 gamm_l = cp_l/cv_l
6181 gamma_l = 1.0_wp/(gamm_l - 1.0_wp)
6182 gamm_r = cp_r/cv_r
6183 gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
6184 end if
6185
6186 call get_mixture_energy_mass(t_l, ys_l, e_l)
6187 call get_mixture_energy_mass(t_r, ys_r, e_r)
6188
6189 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
6190 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
6191 h_l = (e_l + pres_l)/rho_l
6192 h_r = (e_r + pres_r)/rho_r
6193 elseif (mhd .and. relativity) then
6194# 1327 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6195 ga%L = 1._wp/sqrt(1._wp - vel_l_rms)
6196 ga%R = 1._wp/sqrt(1._wp - vel_r_rms)
6197 vdotb%L = vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3)
6198 vdotb%R = vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3)
6199
6200 b4%L(1:3) = b%L(1:3)/ga%L + ga%L*vel_l(1:3)*vdotb%L
6201 b4%R(1:3) = b%R(1:3)/ga%R + ga%R*vel_r(1:3)*vdotb%R
6202 b2%L = b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp
6203 b2%R = b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp
6204
6205 pres_mag%L = 0.5_wp*(b2%L/ga%L**2._wp + vdotb%L**2._wp)
6206 pres_mag%R = 0.5_wp*(b2%R/ga%R**2._wp + vdotb%R**2._wp)
6207
6208 ! Hard-coded EOS
6209 h_l = 1._wp + (gamma_l + 1)*pres_l/rho_l
6210 h_r = 1._wp + (gamma_r + 1)*pres_r/rho_r
6211
6212 cm%L(1:3) = (rho_l*h_l*ga%L**2 + b2%L)*vel_l(1:3) - vdotb%L*b%L(1:3)
6213 cm%R(1:3) = (rho_r*h_r*ga%R**2 + b2%R)*vel_r(1:3) - vdotb%R*b%R(1:3)
6214
6215 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
6216 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
6217# 1350 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6218 elseif (mhd .and. .not. relativity) then
6219 pres_mag%L = 0.5_wp*(b%L(1)**2._wp + b%L(2)**2._wp + b%L(3)**2._wp)
6220 pres_mag%R = 0.5_wp*(b%R(1)**2._wp + b%R(2)**2._wp + b%R(3)**2._wp)
6221 e_l = gamma_l*pres_l + pi_inf_l + 0.5_wp*rho_l*vel_l_rms + qv_l + pres_mag%L
6222 e_r = gamma_r*pres_r + pi_inf_r + 0.5_wp*rho_r*vel_r_rms + qv_r + pres_mag%R ! includes magnetic energy
6223 h_l = (e_l + pres_l - pres_mag%L)/rho_l
6224 h_r = (e_r + pres_r - pres_mag%R)/rho_r ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
6225 else
6226 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
6227 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
6228 h_l = (e_l + pres_l)/rho_l
6229 h_r = (e_r + pres_r)/rho_r
6230 end if
6231
6232 ! elastic energy update
6233 if (hypoelasticity) then
6234 g_l = 0._wp; g_r = 0._wp
6235
6236
6237# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6238#if defined(MFC_OpenACC)
6239# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6240!$acc loop seq
6241# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6242#elif defined(MFC_OpenMP)
6243# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6244
6245# 1368 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6246#endif
6247 do i = 1, num_fluids
6248 g_l = g_l + alpha_l(i)*gs_rs(i)
6249 g_r = g_r + alpha_r(i)*gs_rs(i)
6250 end do
6251
6252 if (cont_damage) then
6253 g_l = g_l*max((1._wp - ql_prim_rsz_vf(j, k, l, damage_idx)), 0._wp)
6254 g_r = g_r*max((1._wp - qr_prim_rsz_vf(j, k, l, damage_idx)), 0._wp)
6255 end if
6256
6257 do i = 1, strxe - strxb + 1
6258 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
6259 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
6260 ! Elastic contribution to energy if G large enough
6261 !TODO take out if statement if stable without
6262 if ((g_l > 1000) .and. (g_r > 1000)) then
6263 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6264 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6265 ! Double for shear stresses
6266 if (any(strxb - 1 + i == shear_indices)) then
6267 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
6268 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
6269 end if
6270 end if
6271 end do
6272 end if
6273
6274 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
6275 vel_l_rms, 0._wp, c_l, qv_l)
6276
6277 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
6278 vel_r_rms, 0._wp, c_r, qv_r)
6279
6280 if (mhd) then
6281 call s_compute_fast_magnetosonic_speed(rho_l, c_l, b%L, norm_dir, c_fast%L, h_l)
6282 call s_compute_fast_magnetosonic_speed(rho_r, c_r, b%R, norm_dir, c_fast%R, h_r)
6283 end if
6284
6285 s_l = 0._wp; s_r = 0._wp
6286
6287
6288# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6289#if defined(MFC_OpenACC)
6290# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6291!$acc loop seq
6292# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6293#elif defined(MFC_OpenMP)
6294# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6295
6296# 1409 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6297#endif
6298 do i = 1, num_dims
6299 s_l = s_l + vel_l(i)**2._wp
6300 s_r = s_r + vel_r(i)**2._wp
6301 end do
6302
6303 s_l = sqrt(s_l)
6304 s_r = sqrt(s_r)
6305
6306 s_p = max(s_l, s_r) + max(c_l, c_r)
6307 s_m = -s_p
6308
6309 s_l = s_m
6310 s_r = s_p
6311
6312 ! Low Mach correction
6313 if (low_mach == 1) then
6314
6315# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6316 if (riemann_solver == 1 .or. riemann_solver == 5) then
6317# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6318
6319# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6320 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6321# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6322 pcorr = 0._wp
6323# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6324
6325# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6326 if (low_mach == 1) then
6327# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6328 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
6329# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6330 end if
6331# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6332
6333# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6334 else if (riemann_solver == 2) then
6335# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6336 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
6337# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6338 pcorr = 0._wp
6339# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6340
6341# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6342 if (low_mach == 1) then
6343# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6344 pcorr = rho_l*rho_r* &
6345# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6346 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
6347# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6348 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
6349# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6350 (zcoef - 1._wp)
6351# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6352 else if (low_mach == 2) then
6353# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6354 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))))
6355# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6356 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))))
6357# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6358 vel_l(dir_idx(1)) = vel_l_tmp
6359# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6360 vel_r(dir_idx(1)) = vel_r_tmp
6361# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6362 end if
6363# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6364 end if
6365# 1426 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6366
6367 else
6368 pcorr = 0._wp
6369 end if
6370
6371 ! Mass
6372 if (.not. relativity) then
6373
6374# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6375#if defined(MFC_OpenACC)
6376# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6377!$acc loop seq
6378# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6379#elif defined(MFC_OpenMP)
6380# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6381
6382# 1433 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6383#endif
6384 do i = 1, contxe
6385 flux_rsz_vf(j, k, l, i) = &
6386 (s_m*alpha_rho_r(i)*vel_r(norm_dir) &
6387 - s_p*alpha_rho_l(i)*vel_l(norm_dir) &
6388 + s_m*s_p*(alpha_rho_l(i) &
6389 - alpha_rho_r(i))) &
6390 /(s_m - s_p)
6391 end do
6392 elseif (relativity) then
6393
6394# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6395#if defined(MFC_OpenACC)
6396# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6397!$acc loop seq
6398# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6399#elif defined(MFC_OpenMP)
6400# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6401
6402# 1443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6403#endif
6404 do i = 1, contxe
6405 flux_rsz_vf(j, k, l, i) = &
6406 (s_m*ga%R*alpha_rho_r(i)*vel_r(norm_dir) &
6407 - s_p*ga%L*alpha_rho_l(i)*vel_l(norm_dir) &
6408 + s_m*s_p*(ga%L*alpha_rho_l(i) &
6409 - ga%R*alpha_rho_r(i))) &
6410 /(s_m - s_p)
6411 end do
6412 end if
6413
6414 ! Momentum
6415 if (mhd .and. (.not. relativity)) then
6416
6417# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6418#if defined(MFC_OpenACC)
6419# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6420!$acc loop seq
6421# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6422#elif defined(MFC_OpenMP)
6423# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6424
6425# 1456 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6426#endif
6427 do i = 1, 3
6428 ! Flux of rho*v_i in the z direction
6429 ! = rho * v_i * v_z - B_i * B_z + delta_(z,i) * p_tot
6430 flux_rsz_vf(j, k, l, contxe + i) = &
6431 (s_m*(rho_r*vel_r(i)*vel_r(norm_dir) &
6432 - b%R(i)*b%R(norm_dir) &
6433 + dir_flg(i)*(pres_r + pres_mag%R)) &
6434 - s_p*(rho_l*vel_l(i)*vel_l(norm_dir) &
6435 - b%L(i)*b%L(norm_dir) &
6436 + dir_flg(i)*(pres_l + pres_mag%L)) &
6437 + s_m*s_p*(rho_l*vel_l(i) - rho_r*vel_r(i))) &
6438 /(s_m - s_p)
6439 end do
6440 elseif (mhd .and. relativity) then
6441
6442# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6443#if defined(MFC_OpenACC)
6444# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6445!$acc loop seq
6446# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6447#elif defined(MFC_OpenMP)
6448# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6449
6450# 1471 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6451#endif
6452 do i = 1, 3
6453 ! Flux of m_i in the z direction
6454 ! = m_i * v_z - b_i/Gamma * B_z + delta_(z,i) * p_tot
6455 flux_rsz_vf(j, k, l, contxe + i) = &
6456 (s_m*(cm%R(i)*vel_r(norm_dir) &
6457 - b4%R(i)/ga%R*b%R(norm_dir) &
6458 + dir_flg(i)*(pres_r + pres_mag%R)) &
6459 - s_p*(cm%L(i)*vel_l(norm_dir) &
6460 - b4%L(i)/ga%L*b%L(norm_dir) &
6461 + dir_flg(i)*(pres_l + pres_mag%L)) &
6462 + s_m*s_p*(cm%L(i) - cm%R(i))) &
6463 /(s_m - s_p)
6464 end do
6465 elseif (bubbles_euler) then
6466
6467# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6468#if defined(MFC_OpenACC)
6469# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6470!$acc loop seq
6471# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6472#elif defined(MFC_OpenMP)
6473# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6474
6475# 1486 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6476#endif
6477 do i = 1, num_vels
6478 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
6479 (s_m*(rho_r*vel_r(dir_idx(1)) &
6480 *vel_r(dir_idx(i)) &
6481 + dir_flg(dir_idx(i))*(pres_r - ptilde_r)) &
6482 - s_p*(rho_l*vel_l(dir_idx(1)) &
6483 *vel_l(dir_idx(i)) &
6484 + dir_flg(dir_idx(i))*(pres_l - ptilde_l)) &
6485 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
6486 - rho_r*vel_r(dir_idx(i)))) &
6487 /(s_m - s_p) &
6488 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
6489 end do
6490 else if (hypoelasticity) then
6491
6492# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6493#if defined(MFC_OpenACC)
6494# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6495!$acc loop seq
6496# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6497#elif defined(MFC_OpenMP)
6498# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6499
6500# 1501 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6501#endif
6502 do i = 1, num_vels
6503 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
6504 (s_m*(rho_r*vel_r(dir_idx(1)) &
6505 *vel_r(dir_idx(i)) &
6506 + dir_flg(dir_idx(i))*pres_r &
6507 - tau_e_r(dir_idx_tau(i))) &
6508 - s_p*(rho_l*vel_l(dir_idx(1)) &
6509 *vel_l(dir_idx(i)) &
6510 + dir_flg(dir_idx(i))*pres_l &
6511 - tau_e_l(dir_idx_tau(i))) &
6512 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
6513 - rho_r*vel_r(dir_idx(i)))) &
6514 /(s_m - s_p)
6515 end do
6516 else
6517
6518# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6519#if defined(MFC_OpenACC)
6520# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6521!$acc loop seq
6522# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6523#elif defined(MFC_OpenMP)
6524# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6525
6526# 1517 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6527#endif
6528 do i = 1, num_vels
6529 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
6530 (s_m*(rho_r*vel_r(dir_idx(1)) &
6531 *vel_r(dir_idx(i)) &
6532 + dir_flg(dir_idx(i))*pres_r) &
6533 - s_p*(rho_l*vel_l(dir_idx(1)) &
6534 *vel_l(dir_idx(i)) &
6535 + dir_flg(dir_idx(i))*pres_l) &
6536 + s_m*s_p*(rho_l*vel_l(dir_idx(i)) &
6537 - rho_r*vel_r(dir_idx(i)))) &
6538 /(s_m - s_p) &
6539 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r(dir_idx(i)) - vel_l(dir_idx(i)))
6540 end do
6541 end if
6542
6543 ! Energy
6544 if (mhd .and. (.not. relativity)) then
6545 ! energy flux = (E + p + p_mag) * v_z - B_z * (v_x*B_x + v_y*B_y + v_z*B_z)
6546# 1537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6547 flux_rsz_vf(j, k, l, e_idx) = &
6548 (s_m*(vel_r(norm_dir)*(e_r + pres_r + pres_mag%R) - b%R(norm_dir)*(vel_r(1)*b%R(1) + vel_r(2)*b%R(2) + vel_r(3)*b%R(3))) &
6549 - s_p*(vel_l(norm_dir)*(e_l + pres_l + pres_mag%L) - b%L(norm_dir)*(vel_l(1)*b%L(1) + vel_l(2)*b%L(2) + vel_l(3)*b%L(3))) &
6550 + s_m*s_p*(e_l - e_r)) &
6551 /(s_m - s_p)
6552# 1543 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6553 elseif (mhd .and. relativity) then
6554 ! energy flux = m_z - mass flux
6555 ! Hard-coded for single-component for now
6556 flux_rsz_vf(j, k, l, e_idx) = &
6557 (s_m*(cm%R(norm_dir) - ga%R*alpha_rho_r(1)*vel_r(norm_dir)) &
6558 - s_p*(cm%L(norm_dir) - ga%L*alpha_rho_l(1)*vel_l(norm_dir)) &
6559 + s_m*s_p*(e_l - e_r)) &
6560 /(s_m - s_p)
6561 else if (bubbles_euler) then
6562 flux_rsz_vf(j, k, l, e_idx) = &
6563 (s_m*vel_r(dir_idx(1))*(e_r + pres_r - ptilde_r) &
6564 - s_p*vel_l(dir_idx(1))*(e_l + pres_l - ptilde_l) &
6565 + s_m*s_p*(e_l - e_r)) &
6566 /(s_m - s_p) &
6567 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
6568 else if (hypoelasticity) then
6569 flux_tau_l = 0._wp; flux_tau_r = 0._wp
6570
6571# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6572#if defined(MFC_OpenACC)
6573# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6574!$acc loop seq
6575# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6576#elif defined(MFC_OpenMP)
6577# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6578
6579# 1560 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6580#endif
6581 do i = 1, num_dims
6582 flux_tau_l = flux_tau_l + tau_e_l(dir_idx_tau(i))*vel_l(dir_idx(i))
6583 flux_tau_r = flux_tau_r + tau_e_r(dir_idx_tau(i))*vel_r(dir_idx(i))
6584 end do
6585 flux_rsz_vf(j, k, l, e_idx) = &
6586 (s_m*(vel_r(dir_idx(1))*(e_r + pres_r) - flux_tau_r) &
6587 - s_p*(vel_l(dir_idx(1))*(e_l + pres_l) - flux_tau_l) &
6588 + s_m*s_p*(e_l - e_r))/(s_m - s_p)
6589 else
6590 flux_rsz_vf(j, k, l, e_idx) = &
6591 (s_m*vel_r(dir_idx(1))*(e_r + pres_r) &
6592 - s_p*vel_l(dir_idx(1))*(e_l + pres_l) &
6593 + s_m*s_p*(e_l - e_r)) &
6594 /(s_m - s_p) &
6595 + (s_m/s_l)*(s_p/s_r)*pcorr*(vel_r_rms - vel_l_rms)/2._wp
6596 end if
6597
6598 ! Elastic Stresses
6599 if (hypoelasticity) then
6600 do i = 1, strxe - strxb + 1 !TODO: this indexing may be slow
6601 flux_rsz_vf(j, k, l, strxb - 1 + i) = &
6602 (s_m*(rho_r*vel_r(dir_idx(1)) &
6603 *tau_e_r(i)) &
6604 - s_p*(rho_l*vel_l(dir_idx(1)) &
6605 *tau_e_l(i)) &
6606 + s_m*s_p*(rho_l*tau_e_l(i) &
6607 - rho_r*tau_e_r(i))) &
6608 /(s_m - s_p)
6609 end do
6610 end if
6611
6612 ! Advection
6613
6614# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6615#if defined(MFC_OpenACC)
6616# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6617!$acc loop seq
6618# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6619#elif defined(MFC_OpenMP)
6620# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6621
6622# 1593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6623#endif
6624 do i = advxb, advxe
6625 flux_rsz_vf(j, k, l, i) = &
6626 (ql_prim_rsz_vf(j, k, l, i) &
6627 - qr_prim_rsz_vf(j + 1, k, l, i)) &
6628 *s_m*s_p/(s_m - s_p)
6629 flux_src_rsz_vf(j, k, l, i) = &
6630 (s_m*qr_prim_rsz_vf(j + 1, k, l, i) &
6631 - s_p*ql_prim_rsz_vf(j, k, l, i)) &
6632 /(s_m - s_p)
6633 end do
6634
6635 if (bubbles_euler) then
6636 ! From HLLC: Kills mass transport @ bubble gas density
6637 if (num_fluids > 1) then
6638 flux_rsz_vf(j, k, l, contxe) = 0._wp
6639 end if
6640 end if
6641
6642 if (chemistry) then
6643
6644# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6645#if defined(MFC_OpenACC)
6646# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6647!$acc loop seq
6648# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6649#elif defined(MFC_OpenMP)
6650# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6651
6652# 1613 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6653#endif
6654 do i = chemxb, chemxe
6655 y_l = ql_prim_rsz_vf(j, k, l, i)
6656 y_r = qr_prim_rsz_vf(j + 1, k, l, i)
6657
6658 flux_rsz_vf(j, k, l, i) = (s_m*y_r*rho_r*vel_r(dir_idx(1)) &
6659 - s_p*y_l*rho_l*vel_l(dir_idx(1)) &
6660 + s_m*s_p*(y_l*rho_l - y_r*rho_r)) &
6661 /(s_m - s_p)
6662 flux_src_rsz_vf(j, k, l, i) = 0._wp
6663 end do
6664 end if
6665
6666 if (mhd) then
6667 if (n == 0) then ! 1D: d/dx flux only & Bx = Bx0 = const.
6668 ! B_y flux = v_x * B_y - v_y * Bx0
6669 ! B_z flux = v_x * B_z - v_z * Bx0
6670
6671# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6672#if defined(MFC_OpenACC)
6673# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6674!$acc loop seq
6675# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6676#elif defined(MFC_OpenMP)
6677# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6678
6679# 1630 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6680#endif
6681 do i = 0, 1
6682 flux_rsx_vf(j, k, l, b_idx%beg + i) = (s_m*(vel_r(1)*b%R(2 + i) - vel_r(2 + i)*bx0) &
6683 - s_p*(vel_l(1)*b%L(2 + i) - vel_l(2 + i)*bx0) &
6684 + s_m*s_p*(b%L(2 + i) - b%R(2 + i)))/(s_m - s_p)
6685 end do
6686 else ! 2D/3D: Bx, By, Bz /= const. but zero flux component in the same direction
6687 ! B_x d/dz flux = (1 - delta(x,z)) * (v_z * B_x - v_x * B_z)
6688 ! B_y d/dz flux = (1 - delta(y,z)) * (v_z * B_y - v_y * B_z)
6689 ! B_z d/dz flux = (1 - delta(z,z)) * (v_z * B_z - v_z * B_z)
6690
6691# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6692#if defined(MFC_OpenACC)
6693# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6694!$acc loop seq
6695# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6696#elif defined(MFC_OpenMP)
6697# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6698
6699# 1640 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6700#endif
6701 do i = 0, 2
6702 flux_rsz_vf(j, k, l, b_idx%beg + i) = (1 - dir_flg(i + 1))*( &
6703 s_m*(vel_r(dir_idx(1))*b%R(i + 1) - vel_r(i + 1)*b%R(norm_dir)) - &
6704 s_p*(vel_l(dir_idx(1))*b%L(i + 1) - vel_l(i + 1)*b%L(norm_dir)) + &
6705 s_m*s_p*(b%L(i + 1) - b%R(i + 1)))/(s_m - s_p)
6706 end do
6707 end if
6708 flux_src_rsz_vf(j, k, l, advxb) = 0._wp
6709 end if
6710
6711# 1682 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6712 end do
6713 end do
6714 end do
6715
6716# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6717
6718# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6719#if defined(MFC_OpenACC)
6720# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6721!$acc end parallel loop
6722# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6723#elif defined(MFC_OpenMP)
6724# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6725
6726# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6727
6728# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6729!$omp end target teams loop
6730# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6731#endif
6732# 1685 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6733
6734 end if
6735
6736# 1689 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6737
6738 if (viscous .or. dummy) then
6739
6740# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6741
6742# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6743#if defined(MFC_OpenACC)
6744# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6745!$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)
6746# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6747#elif defined(MFC_OpenMP)
6748# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6749
6750# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6751
6752# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6753
6754# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6755!$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)
6756# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6757#endif
6758# 1691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6759
6760 do l = isz%beg, isz%end
6761 do k = isy%beg, isy%end
6762 do j = isx%beg, isx%end
6763 idx_right_phys(1) = j
6764 idx_right_phys(2) = k
6765 idx_right_phys(3) = l
6766 idx_right_phys(norm_dir) = idx_right_phys(norm_dir) + 1
6767
6768 if (norm_dir == 1) then
6769
6770# 1701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6771#if defined(MFC_OpenACC)
6772# 1701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6773!$acc loop seq
6774# 1701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6775#elif defined(MFC_OpenMP)
6776# 1701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6777
6778# 1701 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6779#endif
6780 do i = 1, num_fluids
6781 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
6782 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
6783 end do
6784
6785
6786# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6787#if defined(MFC_OpenACC)
6788# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6789!$acc loop seq
6790# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6791#elif defined(MFC_OpenMP)
6792# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6793
6794# 1707 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6795#endif
6796 do i = 1, num_dims
6797 vel_l(i) = ql_prim_rsx_vf(j, k, l, momxb + i - 1)
6798 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, momxb + i - 1)
6799 end do
6800 else if (norm_dir == 2) then
6801
6802# 1713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6803#if defined(MFC_OpenACC)
6804# 1713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6805!$acc loop seq
6806# 1713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6807#elif defined(MFC_OpenMP)
6808# 1713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6809
6810# 1713 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6811#endif
6812 do i = 1, num_fluids
6813 alpha_l(i) = ql_prim_rsy_vf(k, j, l, e_idx + i)
6814 alpha_r(i) = qr_prim_rsy_vf(k + 1, j, l, e_idx + i)
6815 end do
6816
6817# 1718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6818#if defined(MFC_OpenACC)
6819# 1718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6820!$acc loop seq
6821# 1718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6822#elif defined(MFC_OpenMP)
6823# 1718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6824
6825# 1718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6826#endif
6827 do i = 1, num_dims
6828 vel_l(i) = ql_prim_rsy_vf(k, j, l, momxb + i - 1)
6829 vel_r(i) = qr_prim_rsy_vf(k + 1, j, l, momxb + i - 1)
6830 end do
6831 else
6832
6833# 1724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6834#if defined(MFC_OpenACC)
6835# 1724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6836!$acc loop seq
6837# 1724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6838#elif defined(MFC_OpenMP)
6839# 1724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6840
6841# 1724 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6842#endif
6843 do i = 1, num_fluids
6844 alpha_l(i) = ql_prim_rsz_vf(l, k, j, e_idx + i)
6845 alpha_r(i) = qr_prim_rsz_vf(l + 1, k, j, e_idx + i)
6846 end do
6847
6848
6849# 1730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6850#if defined(MFC_OpenACC)
6851# 1730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6852!$acc loop seq
6853# 1730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6854#elif defined(MFC_OpenMP)
6855# 1730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6856
6857# 1730 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6858#endif
6859 do i = 1, num_dims
6860 vel_l(i) = ql_prim_rsz_vf(l, k, j, momxb + i - 1)
6861 vel_r(i) = qr_prim_rsz_vf(l + 1, k, j, momxb + i - 1)
6862 end do
6863 end if
6864
6865
6866# 1737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6867#if defined(MFC_OpenACC)
6868# 1737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6869!$acc loop seq
6870# 1737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6871#elif defined(MFC_OpenMP)
6872# 1737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6873
6874# 1737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6875#endif
6876 do i = 1, 2
6877 re_l(i) = dflt_real
6878 re_r(i) = dflt_real
6879
6880 if (re_size(i) > 0) re_l(i) = 0._wp
6881 if (re_size(i) > 0) re_r(i) = 0._wp
6882
6883
6884# 1745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6885#if defined(MFC_OpenACC)
6886# 1745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6887!$acc loop seq
6888# 1745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6889#elif defined(MFC_OpenMP)
6890# 1745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6891
6892# 1745 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6893#endif
6894 do q = 1, re_size(i)
6895 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
6896 + re_l(i)
6897 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
6898 + re_r(i)
6899 end do
6900
6901 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
6902 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
6903 end do
6904
6905 if (shear_stress) then
6906
6907
6908# 1759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6909#if defined(MFC_OpenACC)
6910# 1759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6911!$acc loop seq
6912# 1759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6913#elif defined(MFC_OpenMP)
6914# 1759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6915
6916# 1759 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6917#endif
6918 do i = 1, num_dims
6919 vel_grad_l(i, 1) = (dql_prim_dx_vf(momxb + i - 1)%sf(j, k, l)/re_l(1))
6920 vel_grad_r(i, 1) = (dqr_prim_dx_vf(momxb + i - 1)%sf(idx_right_phys(1), idx_right_phys(2), idx_right_phys(3))/re_r(1))
6921# 1764 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6922 if (num_dims > 1) then
6923 vel_grad_l(i, 2) = (dql_prim_dy_vf(momxb + i - 1)%sf(j, k, l)/re_l(1))
6924 vel_grad_r(i, 2) = (dqr_prim_dy_vf(momxb + i - 1)%sf(idx_right_phys(1), idx_right_phys(2), idx_right_phys(3))/re_r(1))
6925 end if
6926# 1769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6927 if (num_dims > 2) then
6928 vel_grad_l(i, 3) = (dql_prim_dz_vf(momxb + i - 1)%sf(j, k, l)/re_l(1))
6929 vel_grad_r(i, 3) = (dqr_prim_dz_vf(momxb + i - 1)%sf(idx_right_phys(1), idx_right_phys(2), idx_right_phys(3))/re_r(1))
6930 end if
6931# 1774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6932# 1775 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6933 end do
6934
6935 if (norm_dir == 1) then
6936 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6937 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(1) + vel_grad_r(1, 1)*vel_r(1))
6938# 1781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6939 if (num_dims > 1) then
6940 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6941 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(1) + vel_grad_r(2, 2)*vel_r(1))
6942
6943 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 2) + vel_grad_r(1, 2)) - 0.5_wp*(vel_grad_l(2, 1) + vel_grad_r(2, 1))
6944 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 2)*vel_l(2) + vel_grad_r(1, 2)*vel_r(2)) - 0.5_wp*(vel_grad_l(2, 1)*vel_l(2) + vel_grad_r(2, 1)*vel_r(2))
6945# 1788 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6946 if (num_dims > 2) then
6947 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6948 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3)*vel_l(1) + vel_grad_r(3, 3)*vel_r(1))
6949
6950 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 3) + vel_grad_r(1, 3)) - 0.5_wp*(vel_grad_l(3, 1) + vel_grad_r(3, 1))
6951 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 3)*vel_l(3) + vel_grad_r(1, 3)*vel_r(3)) - 0.5_wp*(vel_grad_l(3, 1)*vel_l(3) + vel_grad_r(3, 1)*vel_r(3))
6952 end if
6953# 1796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6954 end if
6955# 1798 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6956
6957 else if (norm_dir == 2) then
6958# 1801 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6959 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6960 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(2) + vel_grad_r(1, 1)*vel_r(2))
6961
6962 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6963 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(2) + vel_grad_r(2, 2)*vel_r(2))
6964
6965 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 2) + vel_grad_r(1, 2)) - 0.5_wp*(vel_grad_l(2, 1) + vel_grad_r(2, 1))
6966 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 2)*vel_l(1) + vel_grad_r(1, 2)*vel_r(1)) - 0.5_wp*(vel_grad_l(2, 1)*vel_l(1) + vel_grad_r(2, 1)*vel_r(1))
6967# 1810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6968 if (num_dims > 2) then
6969 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6970 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3)*vel_l(2) + vel_grad_r(3, 3)*vel_r(2))
6971
6972 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, 3) + vel_grad_r(2, 3)) - 0.5_wp*(vel_grad_l(3, 2) + vel_grad_r(3, 2))
6973 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, 3)*vel_l(3) + vel_grad_r(2, 3)*vel_r(3)) - 0.5_wp*(vel_grad_l(3, 2)*vel_l(3) + vel_grad_r(3, 2)*vel_r(3))
6974 end if
6975# 1818 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6976# 1819 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6977 else
6978# 1821 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6979 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
6980 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(1, 1)*vel_l(3) + vel_grad_r(1, 1)*vel_r(3))
6981
6982 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
6983 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - (-2._wp/3._wp)*0.5_wp*(vel_grad_l(2, 2)*vel_l(3) + vel_grad_r(2, 2)*vel_r(3))
6984
6985 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 3) + vel_grad_r(1, 3)) - 0.5_wp*(vel_grad_l(3, 1) + vel_grad_r(3, 1))
6986 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 3)*vel_l(1) + vel_grad_r(1, 3)*vel_r(1)) - 0.5_wp*(vel_grad_l(3, 1)*vel_l(1) + vel_grad_r(3, 1)*vel_r(1))
6987
6988 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
6989 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - (4._wp/3._wp)*0.5_wp*(vel_grad_l(3, 3)*vel_l(3) + vel_grad_r(3, 3)*vel_r(3))
6990
6991 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, 3) + vel_grad_r(2, 3)) - 0.5_wp*(vel_grad_l(3, 2) + vel_grad_r(3, 2))
6992 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, 3)*vel_l(2) + vel_grad_r(2, 3)*vel_r(2)) - 0.5_wp*(vel_grad_l(3, 2)*vel_l(2) + vel_grad_r(3, 2)*vel_r(2))
6993# 1836 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
6994 end if
6995 end if
6996
6997 if (bulk_stress) then
6998
6999
7000# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7001#if defined(MFC_OpenACC)
7002# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7003!$acc loop seq
7004# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7005#elif defined(MFC_OpenMP)
7006# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7007
7008# 1841 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7009#endif
7010 do i = 1, num_dims
7011 vel_grad_l(i, 1) = (dql_prim_dx_vf(momxb + i - 1)%sf(j, k, l)/re_l(2))
7012 vel_grad_r(i, 1) = (dqr_prim_dx_vf(momxb + i - 1)%sf(idx_right_phys(1), idx_right_phys(2), idx_right_phys(3))/re_r(2))
7013# 1846 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7014 if (num_dims > 1) then
7015 vel_grad_l(i, 2) = (dql_prim_dy_vf(momxb + i - 1)%sf(j, k, l)/re_l(2))
7016 vel_grad_r(i, 2) = (dqr_prim_dy_vf(momxb + i - 1)%sf(idx_right_phys(1), idx_right_phys(2), idx_right_phys(3))/re_r(2))
7017 end if
7018# 1851 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7019# 1852 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7020 if (num_dims > 2) then
7021 vel_grad_l(i, 3) = (dql_prim_dz_vf(momxb + i - 1)%sf(j, k, l)/re_l(2))
7022 vel_grad_r(i, 3) = (dqr_prim_dz_vf(momxb + i - 1)%sf(idx_right_phys(1), idx_right_phys(2), idx_right_phys(3))/re_r(2))
7023 end if
7024# 1857 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7025 end do
7026
7027 if (norm_dir == 1) then
7028 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
7029 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 1)*vel_l(1) + vel_grad_r(1, 1)*vel_r(1))
7030# 1863 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7031 if (num_dims > 1) then
7032 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
7033 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, 2)*vel_l(1) + vel_grad_r(2, 2)*vel_r(1))
7034
7035# 1868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7036 if (num_dims > 2) then
7037 flux_src_vf(momxb)%sf(j, k, l) = flux_src_vf(momxb)%sf(j, k, l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
7038 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(3, 3)*vel_l(1) + vel_grad_r(3, 3)*vel_r(1))
7039 end if
7040# 1873 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7041 end if
7042# 1875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7043
7044 else if (norm_dir == 2) then
7045# 1878 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7046 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
7047 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 1)*vel_l(2) + vel_grad_r(1, 1)*vel_r(2))
7048
7049 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
7050 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, 2)*vel_l(2) + vel_grad_r(2, 2)*vel_r(2))
7051
7052# 1885 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7053 if (num_dims > 2) then
7054 flux_src_vf(momxb + 1)%sf(j, k, l) = flux_src_vf(momxb + 1)%sf(j, k, l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
7055 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(3, 3)*vel_l(2) + vel_grad_r(3, 3)*vel_r(2))
7056 end if
7057# 1890 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7058# 1891 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7059 else
7060# 1893 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7061 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 1) + vel_grad_r(1, 1))
7062 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(1, 1)*vel_l(3) + vel_grad_r(1, 1)*vel_r(3))
7063
7064 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, 2) + vel_grad_r(2, 2))
7065 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(2, 2)*vel_l(3) + vel_grad_r(2, 2)*vel_r(3))
7066
7067 flux_src_vf(momxb + 2)%sf(j, k, l) = flux_src_vf(momxb + 2)%sf(j, k, l) - 0.5_wp*(vel_grad_l(3, 3) + vel_grad_r(3, 3))
7068 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - 0.5_wp*(vel_grad_l(3, 3)*vel_l(3) + vel_grad_r(3, 3)*vel_r(3))
7069# 1902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7070 end if
7071
7072 end if
7073 end do
7074 end do
7075 end do
7076
7077# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7078
7079# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7080#if defined(MFC_OpenACC)
7081# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7082!$acc end parallel loop
7083# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7084#elif defined(MFC_OpenMP)
7085# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7086
7087# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7088
7089# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7090!$omp end target teams loop
7091# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7092#endif
7093# 1908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7094
7095
7096 end if
7097
7098 call s_finalize_riemann_solver(flux_vf, flux_src_vf, &
7099 flux_gsrc_vf, &
7100 norm_dir)
7101
7102 end subroutine s_lf_riemann_solver
7103
7104 !> This procedure is the implementation of the Harten, Lax,
7105 !! van Leer, and contact (HLLC) approximate Riemann solver,
7106 !! see Toro (1999) and Johnsen (2007). The viscous and the
7107 !! surface tension effects have been included by modifying
7108 !! the exact Riemann solver of Perigaud and Saurel (2005).
7109 !! @param qL_prim_rsx_vf Left WENO-reconstructed cell-boundary values (x-dir)
7110 !! @param qL_prim_rsy_vf Left WENO-reconstructed cell-boundary values (y-dir)
7111 !! @param qL_prim_rsz_vf Left WENO-reconstructed cell-boundary values (z-dir)
7112 !! @param dqL_prim_dx_vf The left WENO-reconstructed cell-boundary values of the
7113 !! first-order x-dir spatial derivatives
7114 !! @param dqL_prim_dy_vf The left WENO-reconstructed cell-boundary values of the
7115 !! first-order y-dir spatial derivatives
7116 !! @param dqL_prim_dz_vf The left WENO-reconstructed cell-boundary values of the
7117 !! first-order z-dir spatial derivatives
7118 !! @param qL_prim_vf The left WENO-reconstructed cell-boundary values of the
7119 !! cell-average primitive variables
7120 !! @param qR_prim_rsx_vf Right WENO-reconstructed cell-boundary values (x-dir)
7121 !! @param qR_prim_rsy_vf Right WENO-reconstructed cell-boundary values (y-dir)
7122 !! @param qR_prim_rsz_vf Right WENO-reconstructed cell-boundary values (z-dir)
7123 !! @param dqR_prim_dx_vf The right WENO-reconstructed cell-boundary values of the
7124 !! first-order x-dir spatial derivatives
7125 !! @param dqR_prim_dy_vf The right WENO-reconstructed cell-boundary values of the
7126 !! first-order y-dir spatial derivatives
7127 !! @param dqR_prim_dz_vf The right WENO-reconstructed cell-boundary values of the
7128 !! first-order z-dir spatial derivatives
7129 !! @param qR_prim_vf The right WENO-reconstructed cell-boundary values of the
7130 !! cell-average primitive variables
7131 !! @param q_prim_vf Cell-averaged primitive variables
7132 !! @param flux_vf Intra-cell fluxes
7133 !! @param flux_src_vf Intra-cell fluxes sources
7134 !! @param flux_gsrc_vf Intra-cell geometric fluxes sources
7135 !! @param norm_dir Dir. splitting direction
7136 !! @param ix Index bounds in the x-dir
7137 !! @param iy Index bounds in the y-dir
7138 !! @param iz Index bounds in the z-dir
7139 subroutine s_hllc_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, &
7140 dqL_prim_dy_vf, &
7141 dqL_prim_dz_vf, &
7142 qL_prim_vf, &
7143 qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, &
7144 dqR_prim_dy_vf, &
7145 dqR_prim_dz_vf, &
7146 qR_prim_vf, &
7147 q_prim_vf, &
7148 flux_vf, flux_src_vf, &
7149 flux_gsrc_vf, &
7150 norm_dir, ix, iy, iz)
7151
7152 real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(inout) :: ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf
7153 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
7154 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
7155
7156 type(scalar_field), &
7157 allocatable, dimension(:), &
7158 intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, &
7159 dql_prim_dy_vf, dqr_prim_dy_vf, &
7160 dql_prim_dz_vf, dqr_prim_dz_vf
7161
7162 ! Intercell fluxes
7163 type(scalar_field), &
7164 dimension(sys_size), &
7165 intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
7166
7167 integer, intent(in) :: norm_dir
7168 type(int_bounds_info), intent(in) :: ix, iy, iz
7169
7170# 1989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7171 real(wp), dimension(num_fluids) :: alpha_rho_l, alpha_rho_r
7172 real(wp), dimension(num_fluids) :: alpha_l, alpha_r
7173 real(wp), dimension(num_dims) :: vel_l, vel_r
7174# 1993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7175
7176 real(wp) :: rho_l, rho_r
7177 real(wp) :: pres_l, pres_r
7178 real(wp) :: e_l, e_r
7179 real(wp) :: h_l, h_r
7180# 2002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7181 real(wp), dimension(num_species) :: ys_l, ys_r, xs_l, xs_r, gamma_il, gamma_ir, cp_il, cp_ir
7182 real(wp), dimension(num_species) :: yi_avg, phi_avg, h_il, h_ir, h_avg_2
7183# 2005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7184 real(wp) :: cp_avg, cv_avg, t_avg, c_sum_yi_phi, eps
7185 real(wp) :: t_l, t_r
7186 real(wp) :: mw_l, mw_r
7187 real(wp) :: r_gas_l, r_gas_r
7188 real(wp) :: cp_l, cp_r
7189 real(wp) :: cv_l, cv_r
7190 real(wp) :: gamm_l, gamm_r
7191 real(wp) :: y_l, y_r
7192 real(wp) :: gamma_l, gamma_r
7193 real(wp) :: pi_inf_l, pi_inf_r
7194 real(wp) :: qv_l, qv_r
7195 real(wp) :: c_l, c_r
7196 real(wp), dimension(2) :: re_l, re_r
7197
7198 real(wp) :: rho_avg
7199 real(wp) :: h_avg
7200 real(wp) :: gamma_avg
7201 real(wp) :: qv_avg
7202 real(wp) :: c_avg
7203
7204 real(wp) :: s_l, s_r, s_m, s_p, s_s
7205 real(wp) :: xi_l, xi_r !< Left and right wave speeds functions
7206 real(wp) :: xi_m, xi_p
7207 real(wp) :: xi_mp, xi_pp
7208# 2035 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7209 real(wp), dimension(nb) :: r0_l, r0_r
7210 real(wp), dimension(nb) :: v0_l, v0_r
7211 real(wp), dimension(nb) :: p0_l, p0_r
7212 real(wp), dimension(nb) :: pbw_l, pbw_r
7213# 2040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7214
7215 real(wp) :: alpha_l_sum, alpha_r_sum, nbub_l, nbub_r
7216 real(wp) :: ptilde_l, ptilde_r
7217
7218 real(wp) :: pbwr3lbar, pbwr3rbar
7219 real(wp) :: r3lbar, r3rbar
7220 real(wp) :: r3v2lbar, r3v2rbar
7221
7222 real(wp), dimension(6) :: tau_e_l, tau_e_r
7223# 2052 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7224 real(wp), dimension(num_dims) :: xi_field_l, xi_field_r
7225# 2054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7226 real(wp) :: g_l, g_r
7227
7228 real(wp) :: vel_l_rms, vel_r_rms, vel_avg_rms
7229 real(wp) :: vel_l_tmp, vel_r_tmp
7230 real(wp) :: rho_star, e_star, p_star, p_k_star, vel_k_star
7231 real(wp) :: pres_sl, pres_sr, ms_l, ms_r
7232 real(wp) :: flux_ene_e
7233 real(wp) :: zcoef, pcorr !< low Mach number correction
7234
7235 integer :: re_max, i, j, k, l, q !< Generic loop iterators
7236
7237 ! Populating the buffers of the left and right Riemann problem
7238 ! states variables, based on the choice of boundary conditions
7239
7240 call s_populate_riemann_states_variables_buffers( &
7241 ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
7242 dql_prim_dy_vf, &
7243 dql_prim_dz_vf, &
7244 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
7245 dqr_prim_dy_vf, &
7246 dqr_prim_dz_vf, &
7247 norm_dir, ix, iy, iz)
7248
7249 ! Reshaping inputted data based on dimensional splitting direction
7250
7251 call s_initialize_riemann_solver( &
7252 flux_src_vf, &
7253 norm_dir)
7254
7255# 2084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7256
7257 if (norm_dir == 1) then
7258
7259 ! 6-EQUATION MODEL WITH HLLC
7260 if (model_eqns == 3) then
7261 !ME3
7262
7263# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7264
7265# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7266#if defined(MFC_OpenACC)
7267# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7268!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
7269# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7270#elif defined(MFC_OpenMP)
7271# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7272
7273# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7274
7275# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7276
7277# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7278!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
7279# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7280#endif
7281# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7282
7283 do l = is3%beg, is3%end
7284 do k = is2%beg, is2%end
7285 do j = is1%beg, is1%end
7286
7287 vel_l_rms = 0._wp; vel_r_rms = 0._wp
7288 rho_l = 0._wp; rho_r = 0._wp
7289 gamma_l = 0._wp; gamma_r = 0._wp
7290 pi_inf_l = 0._wp; pi_inf_r = 0._wp
7291 qv_l = 0._wp; qv_r = 0._wp
7292 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
7293
7294
7295# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7296#if defined(MFC_OpenACC)
7297# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7298!$acc loop seq
7299# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7300#elif defined(MFC_OpenMP)
7301# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7302
7303# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7304#endif
7305 do i = 1, num_dims
7306 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
7307 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
7308 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
7309 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
7310 end do
7311
7312 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
7313 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
7314
7315 rho_l = 0._wp
7316 gamma_l = 0._wp
7317 pi_inf_l = 0._wp
7318 qv_l = 0._wp
7319
7320 rho_r = 0._wp
7321 gamma_r = 0._wp
7322 pi_inf_r = 0._wp
7323 qv_r = 0._wp
7324
7325 alpha_l_sum = 0._wp
7326 alpha_r_sum = 0._wp
7327
7328 if (mpp_lim) then
7329
7330# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7331#if defined(MFC_OpenACC)
7332# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7333!$acc loop seq
7334# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7335#elif defined(MFC_OpenMP)
7336# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7337
7338# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7339#endif
7340 do i = 1, num_fluids
7341 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
7342 ql_prim_rsx_vf(j, k, l, e_idx + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, e_idx + i)), 1._wp)
7343 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, e_idx + i)
7344 end do
7345
7346
7347# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7348#if defined(MFC_OpenACC)
7349# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7350!$acc loop seq
7351# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7352#elif defined(MFC_OpenMP)
7353# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7354
7355# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7356#endif
7357 do i = 1, num_fluids
7358 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
7359 qr_prim_rsx_vf(j + 1, k, l, e_idx + i) = min(max(0._wp, qr_prim_rsx_vf(j + 1, k, l, e_idx + i)), 1._wp)
7360 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
7361 end do
7362
7363
7364# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7365#if defined(MFC_OpenACC)
7366# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7367!$acc loop seq
7368# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7369#elif defined(MFC_OpenMP)
7370# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7371
7372# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7373#endif
7374 do i = 1, num_fluids
7375 ql_prim_rsx_vf(j, k, l, e_idx + i) = ql_prim_rsx_vf(j, k, l, e_idx + i)/max(alpha_l_sum, sgm_eps)
7376 qr_prim_rsx_vf(j + 1, k, l, e_idx + i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)/max(alpha_r_sum, sgm_eps)
7377 end do
7378 end if
7379
7380
7381# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7382#if defined(MFC_OpenACC)
7383# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7384!$acc loop seq
7385# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7386#elif defined(MFC_OpenMP)
7387# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7388
7389# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7390#endif
7391 do i = 1, num_fluids
7392 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
7393 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*gammas(i)
7394 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*pi_infs(i)
7395 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
7396
7397 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
7398 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*gammas(i)
7399 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
7400 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
7401
7402 alpha_l(i) = ql_prim_rsx_vf(j, k, l, advxb + i - 1)
7403 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, advxb + i - 1)
7404 end do
7405
7406 if (viscous) then
7407
7408# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7409#if defined(MFC_OpenACC)
7410# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7411!$acc loop seq
7412# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7413#elif defined(MFC_OpenMP)
7414# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7415
7416# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7417#endif
7418 do i = 1, 2
7419 re_l(i) = dflt_real
7420 re_r(i) = dflt_real
7421 if (re_size(i) > 0) re_l(i) = 0._wp
7422 if (re_size(i) > 0) re_r(i) = 0._wp
7423
7424# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7425#if defined(MFC_OpenACC)
7426# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7427!$acc loop seq
7428# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7429#elif defined(MFC_OpenMP)
7430# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7431
7432# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7433#endif
7434 do q = 1, re_size(i)
7435 re_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + re_idx(i, q))/res_gs(i, q) &
7436 + re_l(i)
7437 re_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + re_idx(i, q))/res_gs(i, q) &
7438 + re_r(i)
7439 end do
7440 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
7441 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
7442 end do
7443 end if
7444
7445 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
7446 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
7447
7448 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
7449 if (hypoelasticity) then
7450
7451# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7452#if defined(MFC_OpenACC)
7453# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7454!$acc loop seq
7455# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7456#elif defined(MFC_OpenMP)
7457# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7458
7459# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7460#endif
7461 do i = 1, strxe - strxb + 1
7462 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
7463 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
7464 end do
7465 g_l = 0._wp; g_r = 0._wp
7466
7467# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7468#if defined(MFC_OpenACC)
7469# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7470!$acc loop seq
7471# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7472#elif defined(MFC_OpenMP)
7473# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7474
7475# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7476#endif
7477 do i = 1, num_fluids
7478 g_l = g_l + alpha_l(i)*gs_rs(i)
7479 g_r = g_r + alpha_r(i)*gs_rs(i)
7480 end do
7481
7482# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7483#if defined(MFC_OpenACC)
7484# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7485!$acc loop seq
7486# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7487#elif defined(MFC_OpenMP)
7488# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7489
7490# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7491#endif
7492 do i = 1, strxe - strxb + 1
7493 ! Elastic contribution to energy if G large enough
7494 if ((g_l > verysmall) .and. (g_r > verysmall)) then
7495 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
7496 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
7497 ! Additional terms in 2D and 3D
7498 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
7499 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
7500 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
7501 end if
7502 end if
7503 end do
7504 end if
7505
7506 ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY
7507 if (hyperelasticity) then
7508
7509# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7510#if defined(MFC_OpenACC)
7511# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7512!$acc loop seq
7513# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7514#elif defined(MFC_OpenMP)
7515# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7516
7517# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7518#endif
7519 do i = 1, num_dims
7520 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, xibeg - 1 + i)
7521 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, xibeg - 1 + i)
7522 end do
7523 g_l = 0._wp; g_r = 0._wp;
7524
7525# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7526#if defined(MFC_OpenACC)
7527# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7528!$acc loop seq
7529# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7530#elif defined(MFC_OpenMP)
7531# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7532
7533# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7534#endif
7535 do i = 1, num_fluids
7536 ! Mixture left and right shear modulus
7537 g_l = g_l + alpha_l(i)*gs_rs(i)
7538 g_r = g_r + alpha_r(i)*gs_rs(i)
7539 end do
7540 ! Elastic contribution to energy if G large enough
7541 if (g_l > verysmall .and. g_r > verysmall) then
7542 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, xiend + 1)
7543 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, xiend + 1)
7544 end if
7545
7546# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7547#if defined(MFC_OpenACC)
7548# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7549!$acc loop seq
7550# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7551#elif defined(MFC_OpenMP)
7552# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7553
7554# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7555#endif
7556 do i = 1, b_size - 1
7557 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
7558 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
7559 end do
7560 end if
7561
7562 h_l = (e_l + pres_l)/rho_l
7563 h_r = (e_r + pres_r)/rho_r
7564
7565
7566# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7567 if (avg_state == 1) then
7568# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7569
7570# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7571 rho_avg = sqrt(rho_l*rho_r)
7572# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7573
7574# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7575 vel_avg_rms = 0._wp
7576# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7577
7578# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7579
7580# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7581#if defined(MFC_OpenACC)
7582# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7583!$acc loop seq
7584# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7585#elif defined(MFC_OpenMP)
7586# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7587
7588# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7589#endif
7590# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7591 do i = 1, num_vels
7592# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7593 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
7594# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7595 (sqrt(rho_l) + sqrt(rho_r))**2._wp
7596# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7597 end do
7598# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7599
7600# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7601 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
7602# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7603 (sqrt(rho_l) + sqrt(rho_r))
7604# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7605
7606# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7607 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
7608# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7609 (sqrt(rho_l) + sqrt(rho_r))
7610# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7611
7612# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7613 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
7614# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7615 (sqrt(rho_l) + sqrt(rho_r))**2._wp
7616# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7617
7618# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7619 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
7620# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7621 (sqrt(rho_l) + sqrt(rho_r))
7622# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7623
7624# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7625 if (chemistry) then
7626# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7627 eps = 0.001_wp
7628# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7629 call get_species_enthalpies_rt(t_l, h_il)
7630# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7631 call get_species_enthalpies_rt(t_r, h_ir)
7632# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7633 h_il = h_il*gas_constant/molecular_weights*t_l
7634# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7635 h_ir = h_ir*gas_constant/molecular_weights*t_r
7636# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7637 call get_species_specific_heats_r(t_l, cp_il)
7638# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7639 call get_species_specific_heats_r(t_r, cp_ir)
7640# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7641
7642# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7643 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
7644# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7645 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
7646# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7647 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
7648# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7649 if (abs(t_l - t_r) < eps) then
7650# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7651 ! Case when T_L and T_R are very close
7652# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7653 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
7654# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7655 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
7656# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7657 else
7658# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7659 ! Normal calculation when T_L and T_R are sufficiently different
7660# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7661 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
7662# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7663 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
7664# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7665 end if
7666# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7667 gamma_avg = cp_avg/cv_avg
7668# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7669
7670# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7671 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
7672# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7673 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
7674# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7675
7676# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7677 end if
7678# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7679
7680# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7681 end if
7682# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7683
7684# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7685 if (avg_state == 2) then
7686# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7687 rho_avg = 5.e-1_wp*(rho_l + rho_r)
7688# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7689 vel_avg_rms = 0._wp
7690# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7691
7692# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7693#if defined(MFC_OpenACC)
7694# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7695!$acc loop seq
7696# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7697#elif defined(MFC_OpenMP)
7698# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7699
7700# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7701#endif
7702# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7703 do i = 1, num_vels
7704# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7705 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
7706# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7707 end do
7708# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7709
7710# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7711 h_avg = 5.e-1_wp*(h_l + h_r)
7712# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7713 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
7714# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7715 qv_avg = 5.e-1_wp*(qv_l + qv_r)
7716# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7717
7718# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7719 end if
7720# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7721
7722
7723 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
7724 vel_l_rms, 0._wp, c_l, qv_l)
7725
7726 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
7727 vel_r_rms, 0._wp, c_r, qv_r)
7728
7729 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
7730 ! variables are placeholders to call the subroutine.
7731 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
7732 vel_avg_rms, 0._wp, c_avg, qv_avg)
7733
7734 if (viscous) then
7735
7736# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7737#if defined(MFC_OpenACC)
7738# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7739!$acc loop seq
7740# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7741#elif defined(MFC_OpenMP)
7742# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7743
7744# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7745#endif
7746 do i = 1, 2
7747 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
7748 end do
7749 end if
7750
7751 ! Low Mach correction
7752 if (low_mach == 2) then
7753
7754# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7755 if (riemann_solver == 1 .or. riemann_solver == 5) then
7756# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7757
7758# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7759 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7760# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7761 pcorr = 0._wp
7762# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7763
7764# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7765 if (low_mach == 1) then
7766# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7767 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7768# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7769 end if
7770# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7771
7772# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7773 else if (riemann_solver == 2) then
7774# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7775 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7776# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7777 pcorr = 0._wp
7778# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7779
7780# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7781 if (low_mach == 1) then
7782# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7783 pcorr = rho_l*rho_r* &
7784# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7785 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
7786# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7787 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
7788# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7789 (zcoef - 1._wp)
7790# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7791 else if (low_mach == 2) then
7792# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7793 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))))
7794# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7795 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))))
7796# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7797 vel_l(dir_idx(1)) = vel_l_tmp
7798# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7799 vel_r(dir_idx(1)) = vel_r_tmp
7800# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7801 end if
7802# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7803 end if
7804# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7805
7806 end if
7807
7808 ! COMPUTING THE DIRECT WAVE SPEEDS
7809 if (wave_speeds == 1) then
7810 if (elasticity) then
7811 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
7812 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l), vel_r(dir_idx(1)) - sqrt(c_r*c_r + &
7813 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r))
7814 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
7815 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r), vel_l(dir_idx(1)) + sqrt(c_l*c_l + &
7816 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l))
7817 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + &
7818 tau_e_l(dir_idx_tau(1)) + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - &
7819 rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - &
7820 rho_r*(s_r - vel_r(dir_idx(1))))
7821 else
7822 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
7823 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
7824 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
7825 (s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1)))) &
7826 /(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
7827
7828 end if
7829 elseif (wave_speeds == 2) then
7830 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
7831 (vel_l(dir_idx(1)) - &
7832 vel_r(dir_idx(1))))
7833
7834 pres_sr = pres_sl
7835
7836 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
7837 (pres_sl/pres_l - 1._wp)*pres_l/ &
7838 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
7839 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
7840 (pres_sr/pres_r - 1._wp)*pres_r/ &
7841 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
7842
7843 s_l = vel_l(dir_idx(1)) - c_l*ms_l
7844 s_r = vel_r(dir_idx(1)) + c_r*ms_r
7845
7846 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
7847 (pres_l - pres_r)/ &
7848 (rho_avg*c_avg))
7849 end if
7850
7851 ! follows Einfeldt et al.
7852 ! s_M/P = min/max(0.,s_L/R)
7853 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
7854
7855 ! goes with q_star_L/R = xi_L/R * (variable)
7856 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
7857 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
7858 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
7859
7860 ! goes with numerical star velocity in x/y/z directions
7861 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
7862 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
7863 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
7864
7865 ! goes with the numerical velocity in x/y/z directions
7866 ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
7867 xi_mp = -min(0._wp, sign(1._wp, s_l))
7868 xi_pp = max(0._wp, sign(1._wp, s_r))
7869
7870 e_star = xi_m*(e_l + xi_mp*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
7871 (rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1))))) - e_l)) + &
7872 xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
7873 (rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
7874 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) + &
7875 xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
7876
7877 rho_star = xi_m*(rho_l*(xi_mp*xi_l + 1._wp - xi_mp)) + &
7878 xi_p*(rho_r*(xi_pp*xi_r + 1._wp - xi_pp))
7879
7880 vel_k_star = vel_l(dir_idx(1))*(1._wp - xi_mp) + xi_mp*vel_r(dir_idx(1)) + &
7881 xi_mp*xi_pp*(s_s - vel_r(dir_idx(1)))
7882
7883 ! Low Mach correction
7884 if (low_mach == 1) then
7885
7886# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7887 if (riemann_solver == 1 .or. riemann_solver == 5) then
7888# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7889
7890# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7891 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7892# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7893 pcorr = 0._wp
7894# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7895
7896# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7897 if (low_mach == 1) then
7898# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7899 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
7900# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7901 end if
7902# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7903
7904# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7905 else if (riemann_solver == 2) then
7906# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7907 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
7908# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7909 pcorr = 0._wp
7910# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7911
7912# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7913 if (low_mach == 1) then
7914# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7915 pcorr = rho_l*rho_r* &
7916# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7917 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
7918# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7919 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
7920# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7921 (zcoef - 1._wp)
7922# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7923 else if (low_mach == 2) then
7924# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7925 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))))
7926# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7927 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))))
7928# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7929 vel_l(dir_idx(1)) = vel_l_tmp
7930# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7931 vel_r(dir_idx(1)) = vel_r_tmp
7932# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7933 end if
7934# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7935 end if
7936# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7937
7938 else
7939 pcorr = 0._wp
7940 end if
7941
7942 ! COMPUTING FLUXES
7943 ! MASS FLUX.
7944
7945# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7946#if defined(MFC_OpenACC)
7947# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7948!$acc loop seq
7949# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7950#elif defined(MFC_OpenMP)
7951# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7952
7953# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7954#endif
7955 do i = 1, contxe
7956 flux_rsx_vf(j, k, l, i) = &
7957 xi_m*ql_prim_rsx_vf(j, k, l, i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + &
7958 xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
7959 end do
7960
7961 ! MOMENTUM FLUX.
7962 ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
7963
7964# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7965#if defined(MFC_OpenACC)
7966# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7967!$acc loop seq
7968# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7969#elif defined(MFC_OpenMP)
7970# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7971
7972# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7973#endif
7974 do i = 1, num_dims
7975 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = rho_star*vel_k_star* &
7976 (dir_flg(dir_idx(i))*vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star &
7977 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
7978 end do
7979
7980 ! ENERGY FLUX.
7981 ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
7982 flux_rsx_vf(j, k, l, e_idx) = (e_star + p_star)*vel_k_star &
7983 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
7984
7985 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
7986 if (elasticity) then
7987 flux_ene_e = 0._wp;
7988
7989# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7990#if defined(MFC_OpenACC)
7991# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7992!$acc loop seq
7993# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7994#elif defined(MFC_OpenMP)
7995# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7996
7997# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
7998#endif
7999 do i = 1, num_dims
8000 ! MOMENTUM ELASTIC FLUX.
8001 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
8002 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) &
8003 - xi_m*tau_e_l(dir_idx_tau(i)) - xi_p*tau_e_r(dir_idx_tau(i))
8004 ! ENERGY ELASTIC FLUX.
8005 flux_ene_e = flux_ene_e - &
8006 xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) + &
8007 s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i))/(s_l - vel_l(i)))))) - &
8008 xi_p*(vel_r(dir_idx(i))*tau_e_r(dir_idx_tau(i)) + &
8009 s_p*(xi_r*((s_s - vel_r(i))*(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
8010 end do
8011 flux_rsx_vf(j, k, l, e_idx) = flux_rsx_vf(j, k, l, e_idx) + flux_ene_e
8012 end if
8013
8014 ! VOLUME FRACTION FLUX.
8015
8016# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8017#if defined(MFC_OpenACC)
8018# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8019!$acc loop seq
8020# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8021#elif defined(MFC_OpenMP)
8022# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8023
8024# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8025#endif
8026 do i = advxb, advxe
8027 flux_rsx_vf(j, k, l, i) = &
8028 xi_m*ql_prim_rsx_vf(j, k, l, i)*s_s + &
8029 xi_p*qr_prim_rsx_vf(j + 1, k, l, i)*s_s
8030 end do
8031
8032 ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX.
8033
8034# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8035#if defined(MFC_OpenACC)
8036# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8037!$acc loop seq
8038# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8039#elif defined(MFC_OpenMP)
8040# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8041
8042# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8043#endif
8044 do i = 1, num_dims
8045 vel_src_rsx_vf(j, k, l, dir_idx(i)) = &
8046 xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(s_s*(xi_mp*(xi_l - 1) + 1) - vel_l(dir_idx(i)))) + &
8047 xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(s_s*(xi_pp*(xi_r - 1) + 1) - vel_r(dir_idx(i))))
8048 end do
8049
8050 ! INTERNAL ENERGIES ADVECTION FLUX.
8051 ! K-th pressure and velocity in preparation for the internal energy flux
8052
8053# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8054#if defined(MFC_OpenACC)
8055# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8056!$acc loop seq
8057# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8058#elif defined(MFC_OpenMP)
8059# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8060
8061# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8062#endif
8063 do i = 1, num_fluids
8064 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))* &
8065 xi_l**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) + &
8066 xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i)))* &
8067 xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) + pres_r)
8068
8069 flux_rsx_vf(j, k, l, i + intxb - 1) = &
8070 ((xi_m*ql_prim_rsx_vf(j, k, l, i + advxb - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, i + advxb - 1))* &
8071 (gammas(i)*p_k_star + pi_infs(i)) + &
8072 (xi_m*ql_prim_rsx_vf(j, k, l, i + contxb - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, i + contxb - 1))* &
8073 qvs(i))*vel_k_star &
8074 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s*(xi_m*ql_prim_rsx_vf(j, k, l, i + advxb - 1) + xi_p*qr_prim_rsx_vf(j + 1, k, l, i + advxb - 1))
8075 end do
8076
8077 flux_src_rsx_vf(j, k, l, advxb) = vel_src_rsx_vf(j, k, l, dir_idx(1))
8078
8079 ! HYPOELASTIC STRESS EVOLUTION FLUX.
8080 if (hypoelasticity) then
8081
8082# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8083#if defined(MFC_OpenACC)
8084# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8085!$acc loop seq
8086# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8087#elif defined(MFC_OpenMP)
8088# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8089
8090# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8091#endif
8092 do i = 1, strxe - strxb + 1
8093 flux_rsx_vf(j, k, l, strxb - 1 + i) = &
8094 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + &
8095 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
8096 end do
8097 end if
8098
8099 ! REFERENCE MAP FLUX.
8100 if (hyperelasticity) then
8101
8102# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8103#if defined(MFC_OpenACC)
8104# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8105!$acc loop seq
8106# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8107#elif defined(MFC_OpenMP)
8108# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8109
8110# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8111#endif
8112 do i = 1, num_dims
8113 flux_rsx_vf(j, k, l, xibeg - 1 + i) = &
8114 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
8115 - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + &
8116 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
8117 - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
8118 end do
8119 end if
8120
8121 ! COLOR FUNCTION FLUX
8122 if (surface_tension) then
8123 flux_rsx_vf(j, k, l, c_idx) = &
8124 (xi_m*ql_prim_rsx_vf(j, k, l, c_idx) + &
8125 xi_p*qr_prim_rsx_vf(j + 1, k, l, c_idx))*s_s
8126 end if
8127
8128 ! Geometrical source flux for cylindrical coordinates
8129# 2478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8130# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8131
8132 end do
8133 end do
8134 end do
8135
8136# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8137
8138# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8139#if defined(MFC_OpenACC)
8140# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8141!$acc end parallel loop
8142# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8143#elif defined(MFC_OpenMP)
8144# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8145
8146# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8147
8148# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8149!$omp end target teams loop
8150# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8151#endif
8152# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8153
8154
8155 elseif (model_eqns == 4) then
8156 !ME4
8157
8158# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8159
8160# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8161#if defined(MFC_OpenACC)
8162# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8163!$acc parallel loop collapse(3) gang vector default(present) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
8164# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8165#elif defined(MFC_OpenMP)
8166# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8167
8168# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8169
8170# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8171
8172# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8173!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
8174# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8175#endif
8176# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8177
8178 do l = is3%beg, is3%end
8179 do k = is2%beg, is2%end
8180 do j = is1%beg, is1%end
8181
8182 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8183 rho_l = 0._wp; rho_r = 0._wp
8184 gamma_l = 0._wp; gamma_r = 0._wp
8185 pi_inf_l = 0._wp; pi_inf_r = 0._wp
8186 qv_l = 0._wp; qv_r = 0._wp
8187
8188
8189# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8190#if defined(MFC_OpenACC)
8191# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8192!$acc loop seq
8193# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8194#elif defined(MFC_OpenMP)
8195# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8196
8197# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8198#endif
8199 do i = 1, contxe
8200 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
8201 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
8202 end do
8203
8204
8205# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8206#if defined(MFC_OpenACC)
8207# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8208!$acc loop seq
8209# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8210#elif defined(MFC_OpenMP)
8211# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8212
8213# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8214#endif
8215 do i = 1, num_dims
8216 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
8217 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
8218 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
8219 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
8220 end do
8221
8222
8223# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8224#if defined(MFC_OpenACC)
8225# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8226!$acc loop seq
8227# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8228#elif defined(MFC_OpenMP)
8229# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8230
8231# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8232#endif
8233 do i = 1, num_fluids
8234 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
8235 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
8236 end do
8237
8238# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8239#if defined(MFC_OpenACC)
8240# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8241!$acc loop seq
8242# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8243#elif defined(MFC_OpenMP)
8244# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8245
8246# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8247#endif
8248 do i = 1, num_fluids
8249 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
8250 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
8251 end do
8252
8253
8254# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8255#if defined(MFC_OpenACC)
8256# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8257!$acc loop seq
8258# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8259#elif defined(MFC_OpenMP)
8260# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8261
8262# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8263#endif
8264 do i = 1, num_fluids
8265 rho_l = rho_l + alpha_rho_l(i)
8266 gamma_l = gamma_l + alpha_l(i)*gammas(i)
8267 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
8268 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
8269
8270 rho_r = rho_r + alpha_rho_r(i)
8271 gamma_r = gamma_r + alpha_r(i)*gammas(i)
8272 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
8273 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
8274 end do
8275
8276 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
8277 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
8278
8279 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
8280 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
8281
8282 h_l = (e_l + pres_l)/rho_l
8283 h_r = (e_r + pres_r)/rho_r
8284
8285
8286# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8287 if (avg_state == 1) then
8288# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8289
8290# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8291 rho_avg = sqrt(rho_l*rho_r)
8292# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8293
8294# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8295 vel_avg_rms = 0._wp
8296# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8297
8298# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8299
8300# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8301#if defined(MFC_OpenACC)
8302# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8303!$acc loop seq
8304# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8305#elif defined(MFC_OpenMP)
8306# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8307
8308# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8309#endif
8310# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8311 do i = 1, num_vels
8312# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8313 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
8314# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8315 (sqrt(rho_l) + sqrt(rho_r))**2._wp
8316# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8317 end do
8318# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8319
8320# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8321 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
8322# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8323 (sqrt(rho_l) + sqrt(rho_r))
8324# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8325
8326# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8327 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
8328# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8329 (sqrt(rho_l) + sqrt(rho_r))
8330# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8331
8332# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8333 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
8334# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8335 (sqrt(rho_l) + sqrt(rho_r))**2._wp
8336# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8337
8338# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8339 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
8340# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8341 (sqrt(rho_l) + sqrt(rho_r))
8342# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8343
8344# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8345 if (chemistry) then
8346# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8347 eps = 0.001_wp
8348# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8349 call get_species_enthalpies_rt(t_l, h_il)
8350# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8351 call get_species_enthalpies_rt(t_r, h_ir)
8352# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8353 h_il = h_il*gas_constant/molecular_weights*t_l
8354# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8355 h_ir = h_ir*gas_constant/molecular_weights*t_r
8356# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8357 call get_species_specific_heats_r(t_l, cp_il)
8358# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8359 call get_species_specific_heats_r(t_r, cp_ir)
8360# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8361
8362# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8363 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
8364# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8365 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
8366# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8367 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
8368# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8369 if (abs(t_l - t_r) < eps) then
8370# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8371 ! Case when T_L and T_R are very close
8372# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8373 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
8374# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8375 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
8376# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8377 else
8378# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8379 ! Normal calculation when T_L and T_R are sufficiently different
8380# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8381 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
8382# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8383 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
8384# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8385 end if
8386# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8387 gamma_avg = cp_avg/cv_avg
8388# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8389
8390# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8391 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
8392# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8393 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
8394# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8395
8396# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8397 end if
8398# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8399
8400# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8401 end if
8402# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8403
8404# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8405 if (avg_state == 2) then
8406# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8407 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8408# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8409 vel_avg_rms = 0._wp
8410# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8411
8412# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8413#if defined(MFC_OpenACC)
8414# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8415!$acc loop seq
8416# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8417#elif defined(MFC_OpenMP)
8418# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8419
8420# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8421#endif
8422# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8423 do i = 1, num_vels
8424# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8425 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8426# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8427 end do
8428# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8429
8430# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8431 h_avg = 5.e-1_wp*(h_l + h_r)
8432# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8433 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8434# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8435 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8436# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8437
8438# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8439 end if
8440# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8441
8442
8443 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
8444 vel_l_rms, 0._wp, c_l, qv_l)
8445
8446 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
8447 vel_r_rms, 0._wp, c_r, qv_r)
8448
8449 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8450 ! variables are placeholders to call the subroutine.
8451
8452 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
8453 vel_avg_rms, 0._wp, c_avg, qv_avg)
8454
8455 if (wave_speeds == 1) then
8456 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
8457 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
8458
8459 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
8460 (s_l - vel_l(dir_idx(1))) - &
8461 rho_r*vel_r(dir_idx(1))* &
8462 (s_r - vel_r(dir_idx(1)))) &
8463 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
8464 rho_r*(s_r - vel_r(dir_idx(1))))
8465 elseif (wave_speeds == 2) then
8466 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
8467 (vel_l(dir_idx(1)) - &
8468 vel_r(dir_idx(1))))
8469
8470 pres_sr = pres_sl
8471
8472 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
8473 (pres_sl/pres_l - 1._wp)*pres_l/ &
8474 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
8475 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
8476 (pres_sr/pres_r - 1._wp)*pres_r/ &
8477 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
8478
8479 s_l = vel_l(dir_idx(1)) - c_l*ms_l
8480 s_r = vel_r(dir_idx(1)) + c_r*ms_r
8481
8482 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
8483 (pres_l - pres_r)/ &
8484 (rho_avg*c_avg))
8485 end if
8486
8487 ! follows Einfeldt et al.
8488 ! s_M/P = min/max(0.,s_L/R)
8489 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
8490
8491 ! goes with q_star_L/R = xi_L/R * (variable)
8492 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
8493 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
8494 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
8495
8496 ! goes with numerical velocity in x/y/z directions
8497 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
8498 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
8499 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
8500
8501
8502# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8503#if defined(MFC_OpenACC)
8504# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8505!$acc loop seq
8506# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8507#elif defined(MFC_OpenMP)
8508# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8509
8510# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8511#endif
8512 do i = 1, contxe
8513 flux_rsx_vf(j, k, l, i) = &
8514 xi_m*alpha_rho_l(i) &
8515 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8516 + xi_p*alpha_rho_r(i) &
8517 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8518 end do
8519
8520 ! Momentum flux.
8521 ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
8522
8523# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8524#if defined(MFC_OpenACC)
8525# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8526!$acc loop seq
8527# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8528#elif defined(MFC_OpenMP)
8529# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8530
8531# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8532#endif
8533 do i = 1, num_dims
8534 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
8535 xi_m*(rho_l*(vel_l(dir_idx(1))* &
8536 vel_l(dir_idx(i)) + &
8537 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
8538 (1._wp - dir_flg(dir_idx(i)))* &
8539 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
8540 dir_flg(dir_idx(i))*pres_l) &
8541 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
8542 vel_r(dir_idx(i)) + &
8543 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
8544 (1._wp - dir_flg(dir_idx(i)))* &
8545 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
8546 dir_flg(dir_idx(i))*pres_r)
8547 end do
8548
8549 if (bubbles_euler) then
8550 ! Put p_tilde in
8551
8552# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8553#if defined(MFC_OpenACC)
8554# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8555!$acc loop seq
8556# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8557#elif defined(MFC_OpenMP)
8558# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8559
8560# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8561#endif
8562 do i = 1, num_dims
8563 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
8564 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) + &
8565 xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l)) &
8566 + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
8567 end do
8568 end if
8569
8570 flux_rsx_vf(j, k, l, e_idx) = 0._wp
8571
8572
8573# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8574#if defined(MFC_OpenACC)
8575# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8576!$acc loop seq
8577# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8578#elif defined(MFC_OpenMP)
8579# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8580
8581# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8582#endif
8583 do i = alf_idx, alf_idx !only advect the void fraction
8584 flux_rsx_vf(j, k, l, i) = &
8585 xi_m*ql_prim_rsx_vf(j, k, l, i) &
8586 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8587 + xi_p*qr_prim_rsx_vf(j + 1, k, l, i) &
8588 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8589 end do
8590
8591 ! Source for volume fraction advection equation
8592
8593# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8594#if defined(MFC_OpenACC)
8595# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8596!$acc loop seq
8597# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8598#elif defined(MFC_OpenMP)
8599# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8600
8601# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8602#endif
8603 do i = 1, num_dims
8604
8605 vel_src_rsx_vf(j, k, l, dir_idx(i)) = 0._wp
8606 !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
8607 end do
8608
8609 flux_src_rsx_vf(j, k, l, advxb) = vel_src_rsx_vf(j, k, l, dir_idx(1))
8610
8611 ! Add advection flux for bubble variables
8612 if (bubbles_euler) then
8613
8614# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8615#if defined(MFC_OpenACC)
8616# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8617!$acc loop seq
8618# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8619#elif defined(MFC_OpenMP)
8620# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8621
8622# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8623#endif
8624 do i = bubxb, bubxe
8625 flux_rsx_vf(j, k, l, i) = &
8626 xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, i) &
8627 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
8628 + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, i) &
8629 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
8630 end do
8631 end if
8632
8633 ! Geometrical source flux for cylindrical coordinates
8634
8635# 2716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8636# 2736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8637 end do
8638 end do
8639 end do
8640
8641# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8642
8643# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8644#if defined(MFC_OpenACC)
8645# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8646!$acc end parallel loop
8647# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8648#elif defined(MFC_OpenMP)
8649# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8650
8651# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8652
8653# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8654!$omp end target teams loop
8655# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8656#endif
8657# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8658
8659
8660 elseif (model_eqns == 2 .and. bubbles_euler) then
8661
8662# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8663
8664# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8665#if defined(MFC_OpenACC)
8666# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8667!$acc parallel loop collapse(3) gang vector default(present) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar)
8668# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8669#elif defined(MFC_OpenMP)
8670# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8671
8672# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8673
8674# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8675
8676# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8677!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar)
8678# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8679#endif
8680# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8681
8682 do l = is3%beg, is3%end
8683 do k = is2%beg, is2%end
8684 do j = is1%beg, is1%end
8685
8686 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8687 rho_l = 0._wp; rho_r = 0._wp
8688 gamma_l = 0._wp; gamma_r = 0._wp
8689 pi_inf_l = 0._wp; pi_inf_r = 0._wp
8690 qv_l = 0._wp; qv_r = 0._wp
8691
8692
8693# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8694#if defined(MFC_OpenACC)
8695# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8696!$acc loop seq
8697# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8698#elif defined(MFC_OpenMP)
8699# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8700
8701# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8702#endif
8703 do i = 1, num_fluids
8704 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
8705 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
8706 end do
8707
8708 vel_l_rms = 0._wp; vel_r_rms = 0._wp
8709
8710
8711# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8712#if defined(MFC_OpenACC)
8713# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8714!$acc loop seq
8715# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8716#elif defined(MFC_OpenMP)
8717# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8718
8719# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8720#endif
8721 do i = 1, num_dims
8722 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
8723 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
8724 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
8725 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
8726 end do
8727
8728 ! Retain this in the refactor
8729 if (mpp_lim .and. (num_fluids > 2)) then
8730
8731# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8732#if defined(MFC_OpenACC)
8733# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8734!$acc loop seq
8735# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8736#elif defined(MFC_OpenMP)
8737# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8738
8739# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8740#endif
8741 do i = 1, num_fluids
8742 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
8743 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*gammas(i)
8744 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*pi_infs(i)
8745 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
8746 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
8747 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*gammas(i)
8748 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
8749 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
8750 end do
8751 else if (num_fluids > 2) then
8752
8753# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8754#if defined(MFC_OpenACC)
8755# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8756!$acc loop seq
8757# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8758#elif defined(MFC_OpenMP)
8759# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8760
8761# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8762#endif
8763 do i = 1, num_fluids - 1
8764 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
8765 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*gammas(i)
8766 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*pi_infs(i)
8767 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
8768 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
8769 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*gammas(i)
8770 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
8771 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
8772 end do
8773 else
8774 rho_l = ql_prim_rsx_vf(j, k, l, 1)
8775 gamma_l = gammas(1)
8776 pi_inf_l = pi_infs(1)
8777 qv_l = qvs(1)
8778 rho_r = qr_prim_rsx_vf(j + 1, k, l, 1)
8779 gamma_r = gammas(1)
8780 pi_inf_r = pi_infs(1)
8781 qv_r = qvs(1)
8782 end if
8783
8784 if (viscous) then
8785 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
8786
8787# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8788#if defined(MFC_OpenACC)
8789# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8790!$acc loop seq
8791# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8792#elif defined(MFC_OpenMP)
8793# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8794
8795# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8796#endif
8797 do i = 1, 2
8798 re_l(i) = dflt_real
8799 re_r(i) = dflt_real
8800
8801 if (re_size(i) > 0) re_l(i) = 0._wp
8802 if (re_size(i) > 0) re_r(i) = 0._wp
8803
8804
8805# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8806#if defined(MFC_OpenACC)
8807# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8808!$acc loop seq
8809# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8810#elif defined(MFC_OpenMP)
8811# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8812
8813# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8814#endif
8815 do q = 1, re_size(i)
8816 re_l(i) = (1._wp - ql_prim_rsx_vf(j, k, l, e_idx + re_idx(i, q)))/res_gs(i, q) &
8817 + re_l(i)
8818 re_r(i) = (1._wp - qr_prim_rsx_vf(j + 1, k, l, e_idx + re_idx(i, q)))/res_gs(i, q) &
8819 + re_r(i)
8820 end do
8821
8822 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
8823 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
8824
8825 end do
8826 end if
8827 end if
8828
8829 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
8830 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
8831
8832 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
8833 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
8834
8835 h_l = (e_l + pres_l)/rho_l
8836 h_r = (e_r + pres_r)/rho_r
8837
8838 if (avg_state == 2) then
8839
8840# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8841#if defined(MFC_OpenACC)
8842# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8843!$acc loop seq
8844# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8845#elif defined(MFC_OpenMP)
8846# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8847
8848# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8849#endif
8850 do i = 1, nb
8851 r0_l(i) = ql_prim_rsx_vf(j, k, l, rs(i))
8852 r0_r(i) = qr_prim_rsx_vf(j + 1, k, l, rs(i))
8853
8854 v0_l(i) = ql_prim_rsx_vf(j, k, l, vs(i))
8855 v0_r(i) = qr_prim_rsx_vf(j + 1, k, l, vs(i))
8856 if (.not. polytropic .and. .not. qbmm) then
8857 p0_l(i) = ql_prim_rsx_vf(j, k, l, ps(i))
8858 p0_r(i) = qr_prim_rsx_vf(j + 1, k, l, ps(i))
8859 end if
8860 end do
8861
8862 if (.not. qbmm) then
8863 if (adv_n) then
8864 nbub_l = ql_prim_rsx_vf(j, k, l, n_idx)
8865 nbub_r = qr_prim_rsx_vf(j + 1, k, l, n_idx)
8866 else
8867 nbub_l = 0._wp
8868 nbub_r = 0._wp
8869
8870# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8871#if defined(MFC_OpenACC)
8872# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8873!$acc loop seq
8874# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8875#elif defined(MFC_OpenMP)
8876# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8877
8878# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8879#endif
8880 do i = 1, nb
8881 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
8882 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
8883 end do
8884
8885 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsx_vf(j, k, l, e_idx + num_fluids)/nbub_l
8886 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsx_vf(j + 1, k, l, e_idx + num_fluids)/nbub_r
8887 end if
8888 else
8889 !nb stored in 0th moment of first R0 bin in variable conversion module
8890 nbub_l = ql_prim_rsx_vf(j, k, l, bubxb)
8891 nbub_r = qr_prim_rsx_vf(j + 1, k, l, bubxb)
8892 end if
8893
8894
8895# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8896#if defined(MFC_OpenACC)
8897# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8898!$acc loop seq
8899# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8900#elif defined(MFC_OpenMP)
8901# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8902
8903# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8904#endif
8905 do i = 1, nb
8906 if (.not. qbmm) then
8907 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
8908 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
8909 end if
8910 end do
8911
8912 if (qbmm) then
8913 pbwr3lbar = mom_sp_rsx_vf(j, k, l, 4)
8914 pbwr3rbar = mom_sp_rsx_vf(j + 1, k, l, 4)
8915
8916 r3lbar = mom_sp_rsx_vf(j, k, l, 1)
8917 r3rbar = mom_sp_rsx_vf(j + 1, k, l, 1)
8918
8919 r3v2lbar = mom_sp_rsx_vf(j, k, l, 3)
8920 r3v2rbar = mom_sp_rsx_vf(j + 1, k, l, 3)
8921 else
8922
8923 pbwr3lbar = 0._wp
8924 pbwr3rbar = 0._wp
8925
8926 r3lbar = 0._wp
8927 r3rbar = 0._wp
8928
8929 r3v2lbar = 0._wp
8930 r3v2rbar = 0._wp
8931
8932
8933# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8934#if defined(MFC_OpenACC)
8935# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8936!$acc loop seq
8937# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8938#elif defined(MFC_OpenMP)
8939# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8940
8941# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8942#endif
8943 do i = 1, nb
8944 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
8945 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
8946
8947 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
8948 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
8949
8950 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
8951 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
8952 end do
8953 end if
8954
8955 rho_avg = 5.e-1_wp*(rho_l + rho_r)
8956 h_avg = 5.e-1_wp*(h_l + h_r)
8957 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
8958 qv_avg = 5.e-1_wp*(qv_l + qv_r)
8959 vel_avg_rms = 0._wp
8960
8961
8962# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8963#if defined(MFC_OpenACC)
8964# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8965!$acc loop seq
8966# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8967#elif defined(MFC_OpenMP)
8968# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8969
8970# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8971#endif
8972 do i = 1, num_dims
8973 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
8974 end do
8975
8976 end if
8977
8978 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
8979 vel_l_rms, 0._wp, c_l, qv_l)
8980
8981 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
8982 vel_r_rms, 0._wp, c_r, qv_r)
8983
8984 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
8985 ! variables are placeholders to call the subroutine.
8986 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
8987 vel_avg_rms, 0._wp, c_avg, qv_avg)
8988
8989 if (viscous) then
8990
8991# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8992#if defined(MFC_OpenACC)
8993# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8994!$acc loop seq
8995# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8996#elif defined(MFC_OpenMP)
8997# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
8998
8999# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9000#endif
9001 do i = 1, 2
9002 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
9003 end do
9004 end if
9005
9006 ! Low Mach correction
9007 if (low_mach == 2) then
9008
9009# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9010 if (riemann_solver == 1 .or. riemann_solver == 5) then
9011# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9012
9013# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9014 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9015# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9016 pcorr = 0._wp
9017# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9018
9019# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9020 if (low_mach == 1) then
9021# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9022 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9023# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9024 end if
9025# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9026
9027# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9028 else if (riemann_solver == 2) then
9029# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9030 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9031# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9032 pcorr = 0._wp
9033# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9034
9035# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9036 if (low_mach == 1) then
9037# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9038 pcorr = rho_l*rho_r* &
9039# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9040 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
9041# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9042 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
9043# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9044 (zcoef - 1._wp)
9045# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9046 else if (low_mach == 2) then
9047# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9048 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))))
9049# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9050 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))))
9051# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9052 vel_l(dir_idx(1)) = vel_l_tmp
9053# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9054 vel_r(dir_idx(1)) = vel_r_tmp
9055# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9056 end if
9057# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9058 end if
9059# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9060
9061 end if
9062
9063 if (wave_speeds == 1) then
9064 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
9065 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
9066
9067 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
9068 (s_l - vel_l(dir_idx(1))) - &
9069 rho_r*vel_r(dir_idx(1))* &
9070 (s_r - vel_r(dir_idx(1)))) &
9071 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
9072 rho_r*(s_r - vel_r(dir_idx(1))))
9073 elseif (wave_speeds == 2) then
9074 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
9075 (vel_l(dir_idx(1)) - &
9076 vel_r(dir_idx(1))))
9077
9078 pres_sr = pres_sl
9079
9080 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
9081 (pres_sl/pres_l - 1._wp)*pres_l/ &
9082 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
9083 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
9084 (pres_sr/pres_r - 1._wp)*pres_r/ &
9085 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
9086
9087 s_l = vel_l(dir_idx(1)) - c_l*ms_l
9088 s_r = vel_r(dir_idx(1)) + c_r*ms_r
9089
9090 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
9091 (pres_l - pres_r)/ &
9092 (rho_avg*c_avg))
9093 end if
9094
9095 ! follows Einfeldt et al.
9096 ! s_M/P = min/max(0.,s_L/R)
9097 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
9098
9099 ! goes with q_star_L/R = xi_L/R * (variable)
9100 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
9101 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
9102 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
9103
9104 ! goes with numerical velocity in x/y/z directions
9105 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
9106 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
9107 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
9108
9109 ! Low Mach correction
9110 if (low_mach == 1) then
9111
9112# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9113 if (riemann_solver == 1 .or. riemann_solver == 5) then
9114# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9115
9116# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9117 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9118# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9119 pcorr = 0._wp
9120# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9121
9122# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9123 if (low_mach == 1) then
9124# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9125 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9126# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9127 end if
9128# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9129
9130# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9131 else if (riemann_solver == 2) then
9132# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9133 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9134# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9135 pcorr = 0._wp
9136# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9137
9138# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9139 if (low_mach == 1) then
9140# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9141 pcorr = rho_l*rho_r* &
9142# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9143 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
9144# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9145 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
9146# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9147 (zcoef - 1._wp)
9148# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9149 else if (low_mach == 2) then
9150# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9151 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))))
9152# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9153 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))))
9154# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9155 vel_l(dir_idx(1)) = vel_l_tmp
9156# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9157 vel_r(dir_idx(1)) = vel_r_tmp
9158# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9159 end if
9160# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9161 end if
9162# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9163
9164 else
9165 pcorr = 0._wp
9166 end if
9167
9168
9169# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9170#if defined(MFC_OpenACC)
9171# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9172!$acc loop seq
9173# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9174#elif defined(MFC_OpenMP)
9175# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9176
9177# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9178#endif
9179 do i = 1, contxe
9180 flux_rsx_vf(j, k, l, i) = &
9181 xi_m*ql_prim_rsx_vf(j, k, l, i) &
9182 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9183 + xi_p*qr_prim_rsx_vf(j + 1, k, l, i) &
9184 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9185 end do
9186
9187 if (bubbles_euler .and. (num_fluids > 1)) then
9188 ! Kill mass transport @ gas density
9189 flux_rsx_vf(j, k, l, contxe) = 0._wp
9190 end if
9191
9192 ! Momentum flux.
9193 ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
9194
9195 ! Include p_tilde
9196
9197 if (avg_state == 2) then
9198 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
9199 pres_l = pres_l - alpha_l(num_fluids)*pres_l
9200 else
9201 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - &
9202 rho_l*r3v2lbar/r3lbar)
9203 end if
9204
9205 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
9206 pres_r = pres_r - alpha_r(num_fluids)*pres_r
9207 else
9208 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - &
9209 rho_r*r3v2rbar/r3rbar)
9210 end if
9211 end if
9212
9213
9214# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9215#if defined(MFC_OpenACC)
9216# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9217!$acc loop seq
9218# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9219#elif defined(MFC_OpenMP)
9220# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9221
9222# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9223#endif
9224 do i = 1, num_dims
9225 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
9226 xi_m*(rho_l*(vel_l(dir_idx(1))* &
9227 vel_l(dir_idx(i)) + &
9228 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
9229 (1._wp - dir_flg(dir_idx(i)))* &
9230 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
9231 dir_flg(dir_idx(i))*(pres_l)) &
9232 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
9233 vel_r(dir_idx(i)) + &
9234 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
9235 (1._wp - dir_flg(dir_idx(i)))* &
9236 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
9237 dir_flg(dir_idx(i))*(pres_r)) &
9238 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
9239 end do
9240
9241 ! Energy flux.
9242 ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
9243 flux_rsx_vf(j, k, l, e_idx) = &
9244 xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + &
9245 s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
9246 (rho_l*s_s + (pres_l)/ &
9247 (s_l - vel_l(dir_idx(1))))) - e_l)) &
9248 + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + &
9249 s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
9250 (rho_r*s_s + (pres_r)/ &
9251 (s_r - vel_r(dir_idx(1))))) - e_r)) &
9252 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
9253
9254 ! Volume fraction flux
9255
9256# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9257#if defined(MFC_OpenACC)
9258# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9259!$acc loop seq
9260# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9261#elif defined(MFC_OpenMP)
9262# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9263
9264# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9265#endif
9266 do i = advxb, advxe
9267 flux_rsx_vf(j, k, l, i) = &
9268 xi_m*ql_prim_rsx_vf(j, k, l, i) &
9269 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9270 + xi_p*qr_prim_rsx_vf(j + 1, k, l, i) &
9271 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9272 end do
9273
9274 ! Source for volume fraction advection equation
9275
9276# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9277#if defined(MFC_OpenACC)
9278# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9279!$acc loop seq
9280# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9281#elif defined(MFC_OpenMP)
9282# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9283
9284# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9285#endif
9286 do i = 1, num_dims
9287 vel_src_rsx_vf(j, k, l, dir_idx(i)) = &
9288 xi_m*(vel_l(dir_idx(i)) + &
9289 dir_flg(dir_idx(i))* &
9290 s_m*(xi_l - 1._wp)) &
9291 + xi_p*(vel_r(dir_idx(i)) + &
9292 dir_flg(dir_idx(i))* &
9293 s_p*(xi_r - 1._wp))
9294
9295 !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
9296 end do
9297
9298 flux_src_rsx_vf(j, k, l, advxb) = vel_src_rsx_vf(j, k, l, dir_idx(1))
9299
9300 ! Add advection flux for bubble variables
9301
9302# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9303#if defined(MFC_OpenACC)
9304# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9305!$acc loop seq
9306# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9307#elif defined(MFC_OpenMP)
9308# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9309
9310# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9311#endif
9312 do i = bubxb, bubxe
9313 flux_rsx_vf(j, k, l, i) = &
9314 xi_m*nbub_l*ql_prim_rsx_vf(j, k, l, i) &
9315 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9316 + xi_p*nbub_r*qr_prim_rsx_vf(j + 1, k, l, i) &
9317 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9318 end do
9319
9320 if (qbmm) then
9321 flux_rsx_vf(j, k, l, bubxb) = &
9322 xi_m*nbub_l &
9323 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9324 + xi_p*nbub_r &
9325 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9326 end if
9327
9328 if (adv_n) then
9329 flux_rsx_vf(j, k, l, n_idx) = &
9330 xi_m*nbub_l &
9331 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
9332 + xi_p*nbub_r &
9333 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
9334 end if
9335
9336 ! Geometrical source flux for cylindrical coordinates
9337# 3150 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9338# 3172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9339 end do
9340 end do
9341 end do
9342
9343# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9344
9345# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9346#if defined(MFC_OpenACC)
9347# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9348!$acc end parallel loop
9349# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9350#elif defined(MFC_OpenMP)
9351# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9352
9353# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9354
9355# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9356!$omp end target teams loop
9357# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9358#endif
9359# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9360
9361 else
9362 ! 5-EQUATION MODEL WITH HLLC
9363
9364# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9365
9366# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9367#if defined(MFC_OpenACC)
9368# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9369!$acc parallel loop collapse(3) gang vector default(present) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) copyin(is1, is2, is3)
9370# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9371#elif defined(MFC_OpenMP)
9372# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9373
9374# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9375
9376# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9377
9378# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9379!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) map(to:is1, is2, is3)
9380# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9381#endif
9382# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9383
9384 do l = is3%beg, is3%end
9385 do k = is2%beg, is2%end
9386 do j = is1%beg, is1%end
9387
9388 vel_l_rms = 0._wp; vel_r_rms = 0._wp
9389 rho_l = 0._wp; rho_r = 0._wp
9390 gamma_l = 0._wp; gamma_r = 0._wp
9391 pi_inf_l = 0._wp; pi_inf_r = 0._wp
9392 qv_l = 0._wp; qv_r = 0._wp
9393 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
9394
9395
9396# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9397#if defined(MFC_OpenACC)
9398# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9399!$acc loop seq
9400# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9401#elif defined(MFC_OpenMP)
9402# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9403
9404# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9405#endif
9406 do i = 1, num_fluids
9407 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
9408 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
9409 end do
9410
9411
9412# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9413#if defined(MFC_OpenACC)
9414# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9415!$acc loop seq
9416# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9417#elif defined(MFC_OpenMP)
9418# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9419
9420# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9421#endif
9422 do i = 1, num_dims
9423 vel_l(i) = ql_prim_rsx_vf(j, k, l, contxe + i)
9424 vel_r(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + i)
9425 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
9426 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
9427 end do
9428
9429 pres_l = ql_prim_rsx_vf(j, k, l, e_idx)
9430 pres_r = qr_prim_rsx_vf(j + 1, k, l, e_idx)
9431
9432 ! Change this by splitting it into the cases
9433 ! present in the bubbles_euler
9434 if (mpp_lim) then
9435
9436# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9437#if defined(MFC_OpenACC)
9438# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9439!$acc loop seq
9440# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9441#elif defined(MFC_OpenMP)
9442# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9443
9444# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9445#endif
9446 do i = 1, num_fluids
9447 ql_prim_rsx_vf(j, k, l, i) = max(0._wp, ql_prim_rsx_vf(j, k, l, i))
9448 ql_prim_rsx_vf(j, k, l, e_idx + i) = min(max(0._wp, ql_prim_rsx_vf(j, k, l, e_idx + i)), 1._wp)
9449 qr_prim_rsx_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsx_vf(j + 1, k, l, i))
9450 qr_prim_rsx_vf(j + 1, k, l, e_idx + i) = min(max(0._wp, qr_prim_rsx_vf(j + 1, k, l, e_idx + i)), 1._wp)
9451 alpha_l_sum = alpha_l_sum + ql_prim_rsx_vf(j, k, l, e_idx + i)
9452 alpha_r_sum = alpha_r_sum + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
9453 end do
9454
9455
9456# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9457#if defined(MFC_OpenACC)
9458# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9459!$acc loop seq
9460# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9461#elif defined(MFC_OpenMP)
9462# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9463
9464# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9465#endif
9466 do i = 1, num_fluids
9467 ql_prim_rsx_vf(j, k, l, e_idx + i) = ql_prim_rsx_vf(j, k, l, e_idx + i)/max(alpha_l_sum, sgm_eps)
9468 qr_prim_rsx_vf(j + 1, k, l, e_idx + i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)/max(alpha_r_sum, sgm_eps)
9469 end do
9470 end if
9471
9472
9473# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9474#if defined(MFC_OpenACC)
9475# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9476!$acc loop seq
9477# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9478#elif defined(MFC_OpenMP)
9479# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9480
9481# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9482#endif
9483 do i = 1, num_fluids
9484 rho_l = rho_l + ql_prim_rsx_vf(j, k, l, i)
9485 gamma_l = gamma_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*gammas(i)
9486 pi_inf_l = pi_inf_l + ql_prim_rsx_vf(j, k, l, e_idx + i)*pi_infs(i)
9487 qv_l = qv_l + ql_prim_rsx_vf(j, k, l, i)*qvs(i)
9488
9489 rho_r = rho_r + qr_prim_rsx_vf(j + 1, k, l, i)
9490 gamma_r = gamma_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*gammas(i)
9491 pi_inf_r = pi_inf_r + qr_prim_rsx_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
9492 qv_r = qv_r + qr_prim_rsx_vf(j + 1, k, l, i)*qvs(i)
9493 end do
9494
9495 re_max = 0
9496 if (re_size(1) > 0) re_max = 1
9497 if (re_size(2) > 0) re_max = 2
9498
9499 if (viscous) then
9500
9501# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9502#if defined(MFC_OpenACC)
9503# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9504!$acc loop seq
9505# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9506#elif defined(MFC_OpenMP)
9507# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9508
9509# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9510#endif
9511 do i = 1, re_max
9512 re_l(i) = 0._wp
9513 re_r(i) = 0._wp
9514
9515
9516# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9517#if defined(MFC_OpenACC)
9518# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9519!$acc loop seq
9520# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9521#elif defined(MFC_OpenMP)
9522# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9523
9524# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9525#endif
9526 do q = 1, re_size(i)
9527 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
9528 + re_l(i)
9529 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
9530 + re_r(i)
9531 end do
9532
9533 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
9534 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
9535 end do
9536 end if
9537
9538 if (chemistry) then
9539 c_sum_yi_phi = 0.0_wp
9540
9541# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9542#if defined(MFC_OpenACC)
9543# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9544!$acc loop seq
9545# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9546#elif defined(MFC_OpenMP)
9547# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9548
9549# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9550#endif
9551 do i = chemxb, chemxe
9552 ys_l(i - chemxb + 1) = ql_prim_rsx_vf(j, k, l, i)
9553 ys_r(i - chemxb + 1) = qr_prim_rsx_vf(j + 1, k, l, i)
9554 end do
9555
9556 call get_mixture_molecular_weight(ys_l, mw_l)
9557 call get_mixture_molecular_weight(ys_r, mw_r)
9558
9559# 3278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9560 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
9561 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
9562# 3281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9563
9564 r_gas_l = gas_constant/mw_l
9565 r_gas_r = gas_constant/mw_r
9566
9567 t_l = pres_l/rho_l/r_gas_l
9568 t_r = pres_r/rho_r/r_gas_r
9569
9570 call get_species_specific_heats_r(t_l, cp_il)
9571 call get_species_specific_heats_r(t_r, cp_ir)
9572
9573 if (chem_params%gamma_method == 1) then
9574 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
9575 gamma_il = cp_il/(cp_il - 1.0_wp)
9576 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
9577
9578 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
9579 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
9580 else if (chem_params%gamma_method == 2) then
9581 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
9582 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
9583 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
9584 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
9585 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
9586
9587 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
9588 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
9589 end if
9590
9591 call get_mixture_energy_mass(t_l, ys_l, e_l)
9592 call get_mixture_energy_mass(t_r, ys_r, e_r)
9593
9594 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
9595 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
9596 h_l = (e_l + pres_l)/rho_l
9597 h_r = (e_r + pres_r)/rho_r
9598 else
9599 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
9600 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
9601
9602 h_l = (e_l + pres_l)/rho_l
9603 h_r = (e_r + pres_r)/rho_r
9604 end if
9605
9606 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
9607 if (hypoelasticity) then
9608
9609# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9610#if defined(MFC_OpenACC)
9611# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9612!$acc loop seq
9613# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9614#elif defined(MFC_OpenMP)
9615# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9616
9617# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9618#endif
9619 do i = 1, strxe - strxb + 1
9620 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
9621 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
9622 end do
9623 g_l = 0._wp
9624 g_r = 0._wp
9625
9626# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9627#if defined(MFC_OpenACC)
9628# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9629!$acc loop seq
9630# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9631#elif defined(MFC_OpenMP)
9632# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9633
9634# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9635#endif
9636 do i = 1, num_fluids
9637 g_l = g_l + alpha_l(i)*gs_rs(i)
9638 g_r = g_r + alpha_r(i)*gs_rs(i)
9639 end do
9640
9641# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9642#if defined(MFC_OpenACC)
9643# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9644!$acc loop seq
9645# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9646#elif defined(MFC_OpenMP)
9647# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9648
9649# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9650#endif
9651 do i = 1, strxe - strxb + 1
9652 ! Elastic contribution to energy if G large enough
9653 if ((g_l > verysmall) .and. (g_r > verysmall)) then
9654 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
9655 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
9656 ! Additional terms in 2D and 3D
9657 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
9658 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
9659 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
9660 end if
9661 end if
9662 end do
9663 end if
9664
9665 ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY
9666 if (hyperelasticity) then
9667
9668# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9669#if defined(MFC_OpenACC)
9670# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9671!$acc loop seq
9672# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9673#elif defined(MFC_OpenMP)
9674# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9675
9676# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9677#endif
9678 do i = 1, num_dims
9679 xi_field_l(i) = ql_prim_rsx_vf(j, k, l, xibeg - 1 + i)
9680 xi_field_r(i) = qr_prim_rsx_vf(j + 1, k, l, xibeg - 1 + i)
9681 end do
9682 g_l = 0._wp
9683 g_r = 0._wp
9684
9685# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9686#if defined(MFC_OpenACC)
9687# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9688!$acc loop seq
9689# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9690#elif defined(MFC_OpenMP)
9691# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9692
9693# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9694#endif
9695 do i = 1, num_fluids
9696 ! Mixture left and right shear modulus
9697 g_l = g_l + alpha_l(i)*gs_rs(i)
9698 g_r = g_r + alpha_r(i)*gs_rs(i)
9699 end do
9700 ! Elastic contribution to energy if G large enough
9701 if (g_l > verysmall .and. g_r > verysmall) then
9702 e_l = e_l + g_l*ql_prim_rsx_vf(j, k, l, xiend + 1)
9703 e_r = e_r + g_r*qr_prim_rsx_vf(j + 1, k, l, xiend + 1)
9704 end if
9705
9706# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9707#if defined(MFC_OpenACC)
9708# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9709!$acc loop seq
9710# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9711#elif defined(MFC_OpenMP)
9712# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9713
9714# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9715#endif
9716 do i = 1, b_size - 1
9717 tau_e_l(i) = ql_prim_rsx_vf(j, k, l, strxb - 1 + i)
9718 tau_e_r(i) = qr_prim_rsx_vf(j + 1, k, l, strxb - 1 + i)
9719 end do
9720 end if
9721
9722 h_l = (e_l + pres_l)/rho_l
9723 h_r = (e_r + pres_r)/rho_r
9724
9725
9726# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9727 if (avg_state == 1) then
9728# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9729
9730# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9731 rho_avg = sqrt(rho_l*rho_r)
9732# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9733
9734# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9735 vel_avg_rms = 0._wp
9736# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9737
9738# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9739
9740# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9741#if defined(MFC_OpenACC)
9742# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9743!$acc loop seq
9744# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9745#elif defined(MFC_OpenMP)
9746# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9747
9748# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9749#endif
9750# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9751 do i = 1, num_vels
9752# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9753 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
9754# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9755 (sqrt(rho_l) + sqrt(rho_r))**2._wp
9756# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9757 end do
9758# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9759
9760# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9761 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
9762# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9763 (sqrt(rho_l) + sqrt(rho_r))
9764# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9765
9766# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9767 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
9768# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9769 (sqrt(rho_l) + sqrt(rho_r))
9770# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9771
9772# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9773 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
9774# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9775 (sqrt(rho_l) + sqrt(rho_r))**2._wp
9776# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9777
9778# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9779 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
9780# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9781 (sqrt(rho_l) + sqrt(rho_r))
9782# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9783
9784# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9785 if (chemistry) then
9786# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9787 eps = 0.001_wp
9788# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9789 call get_species_enthalpies_rt(t_l, h_il)
9790# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9791 call get_species_enthalpies_rt(t_r, h_ir)
9792# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9793 h_il = h_il*gas_constant/molecular_weights*t_l
9794# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9795 h_ir = h_ir*gas_constant/molecular_weights*t_r
9796# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9797 call get_species_specific_heats_r(t_l, cp_il)
9798# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9799 call get_species_specific_heats_r(t_r, cp_ir)
9800# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9801
9802# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9803 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
9804# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9805 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
9806# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9807 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
9808# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9809 if (abs(t_l - t_r) < eps) then
9810# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9811 ! Case when T_L and T_R are very close
9812# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9813 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
9814# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9815 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
9816# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9817 else
9818# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9819 ! Normal calculation when T_L and T_R are sufficiently different
9820# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9821 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
9822# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9823 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
9824# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9825 end if
9826# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9827 gamma_avg = cp_avg/cv_avg
9828# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9829
9830# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9831 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
9832# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9833 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
9834# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9835
9836# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9837 end if
9838# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9839
9840# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9841 end if
9842# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9843
9844# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9845 if (avg_state == 2) then
9846# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9847 rho_avg = 5.e-1_wp*(rho_l + rho_r)
9848# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9849 vel_avg_rms = 0._wp
9850# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9851
9852# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9853#if defined(MFC_OpenACC)
9854# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9855!$acc loop seq
9856# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9857#elif defined(MFC_OpenMP)
9858# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9859
9860# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9861#endif
9862# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9863 do i = 1, num_vels
9864# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9865 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
9866# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9867 end do
9868# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9869
9870# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9871 h_avg = 5.e-1_wp*(h_l + h_r)
9872# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9873 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
9874# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9875 qv_avg = 5.e-1_wp*(qv_l + qv_r)
9876# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9877
9878# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9879 end if
9880# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9881
9882
9883 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
9884 vel_l_rms, 0._wp, c_l, qv_l)
9885
9886 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
9887 vel_r_rms, 0._wp, c_r, qv_r)
9888
9889 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
9890 ! variables are placeholders to call the subroutine.
9891 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
9892 vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
9893
9894 if (viscous) then
9895 if (chemistry) then
9896 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
9897 end if
9898
9899# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9900#if defined(MFC_OpenACC)
9901# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9902!$acc loop seq
9903# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9904#elif defined(MFC_OpenMP)
9905# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9906
9907# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9908#endif
9909 do i = 1, 2
9910 re_avg_rsx_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
9911 end do
9912 end if
9913
9914 ! Low Mach correction
9915 if (low_mach == 2) then
9916
9917# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9918 if (riemann_solver == 1 .or. riemann_solver == 5) then
9919# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9920
9921# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9922 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
9923# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9924 pcorr = 0._wp
9925# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9926
9927# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9928 if (low_mach == 1) then
9929# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9930 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
9931# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9932 end if
9933# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9934
9935# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9936 else if (riemann_solver == 2) then
9937# 3408 "/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# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9940 pcorr = 0._wp
9941# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9942
9943# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9944 if (low_mach == 1) then
9945# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9946 pcorr = rho_l*rho_r* &
9947# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9948 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
9949# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9950 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
9951# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9952 (zcoef - 1._wp)
9953# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9954 else if (low_mach == 2) then
9955# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9956 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))))
9957# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9958 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))))
9959# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9960 vel_l(dir_idx(1)) = vel_l_tmp
9961# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9962 vel_r(dir_idx(1)) = vel_r_tmp
9963# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9964 end if
9965# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9966 end if
9967# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
9968
9969 end if
9970
9971 if (wave_speeds == 1) then
9972 if (elasticity) then
9973 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
9974 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l), vel_r(dir_idx(1)) - sqrt(c_r*c_r + &
9975 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r))
9976 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
9977 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r), vel_l(dir_idx(1)) + sqrt(c_l*c_l + &
9978 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l))
9979 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + &
9980 tau_e_l(dir_idx_tau(1)) + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - &
9981 rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - &
9982 rho_r*(s_r - vel_r(dir_idx(1))))
9983 else
9984 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
9985 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
9986 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
9987 (s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1)))) &
9988 /(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
9989
9990 end if
9991 elseif (wave_speeds == 2) then
9992 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
9993 (vel_l(dir_idx(1)) - &
9994 vel_r(dir_idx(1))))
9995
9996 pres_sr = pres_sl
9997
9998 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
9999 (pres_sl/pres_l - 1._wp)*pres_l/ &
10000 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
10001 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
10002 (pres_sr/pres_r - 1._wp)*pres_r/ &
10003 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
10004
10005 s_l = vel_l(dir_idx(1)) - c_l*ms_l
10006 s_r = vel_r(dir_idx(1)) + c_r*ms_r
10007
10008 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
10009 (pres_l - pres_r)/ &
10010 (rho_avg*c_avg))
10011 end if
10012
10013 ! follows Einfeldt et al.
10014 ! s_M/P = min/max(0.,s_L/R)
10015 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
10016
10017 ! goes with q_star_L/R = xi_L/R * (variable)
10018 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
10019 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
10020 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
10021
10022 ! goes with numerical velocity in x/y/z directions
10023 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
10024 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
10025 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
10026
10027 ! Low Mach correction
10028 if (low_mach == 1) then
10029
10030# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10031 if (riemann_solver == 1 .or. riemann_solver == 5) then
10032# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10033
10034# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10035 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
10036# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10037 pcorr = 0._wp
10038# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10039
10040# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10041 if (low_mach == 1) then
10042# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10043 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
10044# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10045 end if
10046# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10047
10048# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10049 else if (riemann_solver == 2) then
10050# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10051 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
10052# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10053 pcorr = 0._wp
10054# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10055
10056# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10057 if (low_mach == 1) then
10058# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10059 pcorr = rho_l*rho_r* &
10060# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10061 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
10062# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10063 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
10064# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10065 (zcoef - 1._wp)
10066# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10067 else if (low_mach == 2) then
10068# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10069 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))))
10070# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10071 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))))
10072# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10073 vel_l(dir_idx(1)) = vel_l_tmp
10074# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10075 vel_r(dir_idx(1)) = vel_r_tmp
10076# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10077 end if
10078# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10079 end if
10080# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10081
10082 else
10083 pcorr = 0._wp
10084 end if
10085
10086 ! COMPUTING THE HLLC FLUXES
10087 ! MASS FLUX.
10088
10089# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10090#if defined(MFC_OpenACC)
10091# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10092!$acc loop seq
10093# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10094#elif defined(MFC_OpenMP)
10095# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10096
10097# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10098#endif
10099 do i = 1, contxe
10100 flux_rsx_vf(j, k, l, i) = &
10101 xi_m*ql_prim_rsx_vf(j, k, l, i) &
10102 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
10103 + xi_p*qr_prim_rsx_vf(j + 1, k, l, i) &
10104 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10105 end do
10106
10107 ! MOMENTUM FLUX.
10108 ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
10109
10110# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10111#if defined(MFC_OpenACC)
10112# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10113!$acc loop seq
10114# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10115#elif defined(MFC_OpenMP)
10116# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10117
10118# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10119#endif
10120 do i = 1, num_dims
10121 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
10122 xi_m*(rho_l*(vel_l(dir_idx(1))* &
10123 vel_l(dir_idx(i)) + &
10124 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
10125 (1._wp - dir_flg(dir_idx(i)))* &
10126 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
10127 dir_flg(dir_idx(i))*(pres_l)) &
10128 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
10129 vel_r(dir_idx(i)) + &
10130 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
10131 (1._wp - dir_flg(dir_idx(i)))* &
10132 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
10133 dir_flg(dir_idx(i))*(pres_r)) &
10134 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
10135 end do
10136
10137 ! ENERGY FLUX.
10138 ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
10139 flux_rsx_vf(j, k, l, e_idx) = &
10140 xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + &
10141 s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
10142 (rho_l*s_s + pres_l/ &
10143 (s_l - vel_l(dir_idx(1))))) - e_l)) &
10144 + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + &
10145 s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
10146 (rho_r*s_s + pres_r/ &
10147 (s_r - vel_r(dir_idx(1))))) - e_r)) &
10148 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
10149
10150 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
10151 if (elasticity) then
10152 flux_ene_e = 0._wp
10153
10154# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10155#if defined(MFC_OpenACC)
10156# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10157!$acc loop seq
10158# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10159#elif defined(MFC_OpenMP)
10160# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10161
10162# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10163#endif
10164 do i = 1, num_dims
10165 ! MOMENTUM ELASTIC FLUX.
10166 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) = &
10167 flux_rsx_vf(j, k, l, contxe + dir_idx(i)) &
10168 - xi_m*tau_e_l(dir_idx_tau(i)) - xi_p*tau_e_r(dir_idx_tau(i))
10169 ! ENERGY ELASTIC FLUX.
10170 flux_ene_e = flux_ene_e - &
10171 xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) + &
10172 s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i))/(s_l - vel_l(i)))))) - &
10173 xi_p*(vel_r(dir_idx(i))*tau_e_r(dir_idx_tau(i)) + &
10174 s_p*(xi_r*((s_s - vel_r(i))*(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
10175 end do
10176 flux_rsx_vf(j, k, l, e_idx) = flux_rsx_vf(j, k, l, e_idx) + flux_ene_e
10177 end if
10178
10179 ! HYPOELASTIC STRESS EVOLUTION FLUX.
10180 if (hypoelasticity) then
10181
10182# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10183#if defined(MFC_OpenACC)
10184# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10185!$acc loop seq
10186# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10187#elif defined(MFC_OpenMP)
10188# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10189
10190# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10191#endif
10192 do i = 1, strxe - strxb + 1
10193 flux_rsx_vf(j, k, l, strxb - 1 + i) = &
10194 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + &
10195 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
10196 end do
10197 end if
10198
10199 ! VOLUME FRACTION FLUX.
10200
10201# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10202#if defined(MFC_OpenACC)
10203# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10204!$acc loop seq
10205# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10206#elif defined(MFC_OpenMP)
10207# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10208
10209# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10210#endif
10211 do i = advxb, advxe
10212 flux_rsx_vf(j, k, l, i) = &
10213 xi_m*ql_prim_rsx_vf(j, k, l, i) &
10214 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
10215 + xi_p*qr_prim_rsx_vf(j + 1, k, l, i) &
10216 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10217 end do
10218
10219 ! VOLUME FRACTION SOURCE FLUX.
10220
10221# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10222#if defined(MFC_OpenACC)
10223# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10224!$acc loop seq
10225# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10226#elif defined(MFC_OpenMP)
10227# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10228
10229# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10230#endif
10231 do i = 1, num_dims
10232 vel_src_rsx_vf(j, k, l, dir_idx(i)) = &
10233 xi_m*(vel_l(dir_idx(i)) + &
10234 dir_flg(dir_idx(i))* &
10235 s_m*(xi_l - 1._wp)) &
10236 + xi_p*(vel_r(dir_idx(i)) + &
10237 dir_flg(dir_idx(i))* &
10238 s_p*(xi_r - 1._wp))
10239 end do
10240
10241 ! COLOR FUNCTION FLUX
10242 if (surface_tension) then
10243 flux_rsx_vf(j, k, l, c_idx) = &
10244 xi_m*ql_prim_rsx_vf(j, k, l, c_idx) &
10245 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
10246 + xi_p*qr_prim_rsx_vf(j + 1, k, l, c_idx) &
10247 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10248 end if
10249
10250 ! REFERENCE MAP FLUX.
10251 if (hyperelasticity) then
10252
10253# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10254#if defined(MFC_OpenACC)
10255# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10256!$acc loop seq
10257# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10258#elif defined(MFC_OpenMP)
10259# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10260
10261# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10262#endif
10263 do i = 1, num_dims
10264 flux_rsx_vf(j, k, l, xibeg - 1 + i) = &
10265 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
10266 - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + &
10267 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
10268 - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
10269 end do
10270 end if
10271
10272 flux_src_rsx_vf(j, k, l, advxb) = vel_src_rsx_vf(j, k, l, dir_idx(1))
10273
10274 if (chemistry) then
10275
10276# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10277#if defined(MFC_OpenACC)
10278# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10279!$acc loop seq
10280# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10281#elif defined(MFC_OpenMP)
10282# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10283
10284# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10285#endif
10286 do i = chemxb, chemxe
10287 y_l = ql_prim_rsx_vf(j, k, l, i)
10288 y_r = qr_prim_rsx_vf(j + 1, k, l, i)
10289
10290 flux_rsx_vf(j, k, l, i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
10291 + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
10292 flux_src_rsx_vf(j, k, l, i) = 0.0_wp
10293 end do
10294 end if
10295
10296 ! Geometrical source flux for cylindrical coordinates
10297# 3631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10298# 3653 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10299
10300 end do
10301 end do
10302 end do
10303
10304# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10305
10306# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10307#if defined(MFC_OpenACC)
10308# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10309!$acc end parallel loop
10310# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10311#elif defined(MFC_OpenMP)
10312# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10313
10314# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10315
10316# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10317!$omp end target teams loop
10318# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10319#endif
10320# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10321
10322 end if
10323 end if
10324# 2084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10325
10326 if (norm_dir == 2) then
10327
10328 ! 6-EQUATION MODEL WITH HLLC
10329 if (model_eqns == 3) then
10330 !ME3
10331
10332# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10333
10334# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10335#if defined(MFC_OpenACC)
10336# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10337!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
10338# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10339#elif defined(MFC_OpenMP)
10340# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10341
10342# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10343
10344# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10345
10346# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10347!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
10348# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10349#endif
10350# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10351
10352 do l = is3%beg, is3%end
10353 do k = is2%beg, is2%end
10354 do j = is1%beg, is1%end
10355
10356 vel_l_rms = 0._wp; vel_r_rms = 0._wp
10357 rho_l = 0._wp; rho_r = 0._wp
10358 gamma_l = 0._wp; gamma_r = 0._wp
10359 pi_inf_l = 0._wp; pi_inf_r = 0._wp
10360 qv_l = 0._wp; qv_r = 0._wp
10361 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
10362
10363
10364# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10365#if defined(MFC_OpenACC)
10366# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10367!$acc loop seq
10368# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10369#elif defined(MFC_OpenMP)
10370# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10371
10372# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10373#endif
10374 do i = 1, num_dims
10375 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
10376 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
10377 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
10378 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
10379 end do
10380
10381 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
10382 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
10383
10384 rho_l = 0._wp
10385 gamma_l = 0._wp
10386 pi_inf_l = 0._wp
10387 qv_l = 0._wp
10388
10389 rho_r = 0._wp
10390 gamma_r = 0._wp
10391 pi_inf_r = 0._wp
10392 qv_r = 0._wp
10393
10394 alpha_l_sum = 0._wp
10395 alpha_r_sum = 0._wp
10396
10397 if (mpp_lim) then
10398
10399# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10400#if defined(MFC_OpenACC)
10401# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10402!$acc loop seq
10403# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10404#elif defined(MFC_OpenMP)
10405# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10406
10407# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10408#endif
10409 do i = 1, num_fluids
10410 ql_prim_rsy_vf(j, k, l, i) = max(0._wp, ql_prim_rsy_vf(j, k, l, i))
10411 ql_prim_rsy_vf(j, k, l, e_idx + i) = min(max(0._wp, ql_prim_rsy_vf(j, k, l, e_idx + i)), 1._wp)
10412 alpha_l_sum = alpha_l_sum + ql_prim_rsy_vf(j, k, l, e_idx + i)
10413 end do
10414
10415
10416# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10417#if defined(MFC_OpenACC)
10418# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10419!$acc loop seq
10420# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10421#elif defined(MFC_OpenMP)
10422# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10423
10424# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10425#endif
10426 do i = 1, num_fluids
10427 qr_prim_rsy_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsy_vf(j + 1, k, l, i))
10428 qr_prim_rsy_vf(j + 1, k, l, e_idx + i) = min(max(0._wp, qr_prim_rsy_vf(j + 1, k, l, e_idx + i)), 1._wp)
10429 alpha_r_sum = alpha_r_sum + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
10430 end do
10431
10432
10433# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10434#if defined(MFC_OpenACC)
10435# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10436!$acc loop seq
10437# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10438#elif defined(MFC_OpenMP)
10439# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10440
10441# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10442#endif
10443 do i = 1, num_fluids
10444 ql_prim_rsy_vf(j, k, l, e_idx + i) = ql_prim_rsy_vf(j, k, l, e_idx + i)/max(alpha_l_sum, sgm_eps)
10445 qr_prim_rsy_vf(j + 1, k, l, e_idx + i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)/max(alpha_r_sum, sgm_eps)
10446 end do
10447 end if
10448
10449
10450# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10451#if defined(MFC_OpenACC)
10452# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10453!$acc loop seq
10454# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10455#elif defined(MFC_OpenMP)
10456# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10457
10458# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10459#endif
10460 do i = 1, num_fluids
10461 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
10462 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*gammas(i)
10463 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*pi_infs(i)
10464 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
10465
10466 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
10467 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*gammas(i)
10468 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
10469 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
10470
10471 alpha_l(i) = ql_prim_rsy_vf(j, k, l, advxb + i - 1)
10472 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, advxb + i - 1)
10473 end do
10474
10475 if (viscous) then
10476
10477# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10478#if defined(MFC_OpenACC)
10479# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10480!$acc loop seq
10481# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10482#elif defined(MFC_OpenMP)
10483# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10484
10485# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10486#endif
10487 do i = 1, 2
10488 re_l(i) = dflt_real
10489 re_r(i) = dflt_real
10490 if (re_size(i) > 0) re_l(i) = 0._wp
10491 if (re_size(i) > 0) re_r(i) = 0._wp
10492
10493# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10494#if defined(MFC_OpenACC)
10495# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10496!$acc loop seq
10497# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10498#elif defined(MFC_OpenMP)
10499# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10500
10501# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10502#endif
10503 do q = 1, re_size(i)
10504 re_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + re_idx(i, q))/res_gs(i, q) &
10505 + re_l(i)
10506 re_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + re_idx(i, q))/res_gs(i, q) &
10507 + re_r(i)
10508 end do
10509 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
10510 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
10511 end do
10512 end if
10513
10514 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
10515 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
10516
10517 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
10518 if (hypoelasticity) then
10519
10520# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10521#if defined(MFC_OpenACC)
10522# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10523!$acc loop seq
10524# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10525#elif defined(MFC_OpenMP)
10526# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10527
10528# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10529#endif
10530 do i = 1, strxe - strxb + 1
10531 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
10532 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
10533 end do
10534 g_l = 0._wp; g_r = 0._wp
10535
10536# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10537#if defined(MFC_OpenACC)
10538# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10539!$acc loop seq
10540# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10541#elif defined(MFC_OpenMP)
10542# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10543
10544# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10545#endif
10546 do i = 1, num_fluids
10547 g_l = g_l + alpha_l(i)*gs_rs(i)
10548 g_r = g_r + alpha_r(i)*gs_rs(i)
10549 end do
10550
10551# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10552#if defined(MFC_OpenACC)
10553# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10554!$acc loop seq
10555# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10556#elif defined(MFC_OpenMP)
10557# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10558
10559# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10560#endif
10561 do i = 1, strxe - strxb + 1
10562 ! Elastic contribution to energy if G large enough
10563 if ((g_l > verysmall) .and. (g_r > verysmall)) then
10564 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
10565 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
10566 ! Additional terms in 2D and 3D
10567 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
10568 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
10569 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
10570 end if
10571 end if
10572 end do
10573 end if
10574
10575 ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY
10576 if (hyperelasticity) then
10577
10578# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10579#if defined(MFC_OpenACC)
10580# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10581!$acc loop seq
10582# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10583#elif defined(MFC_OpenMP)
10584# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10585
10586# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10587#endif
10588 do i = 1, num_dims
10589 xi_field_l(i) = ql_prim_rsy_vf(j, k, l, xibeg - 1 + i)
10590 xi_field_r(i) = qr_prim_rsy_vf(j + 1, k, l, xibeg - 1 + i)
10591 end do
10592 g_l = 0._wp; g_r = 0._wp;
10593
10594# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10595#if defined(MFC_OpenACC)
10596# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10597!$acc loop seq
10598# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10599#elif defined(MFC_OpenMP)
10600# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10601
10602# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10603#endif
10604 do i = 1, num_fluids
10605 ! Mixture left and right shear modulus
10606 g_l = g_l + alpha_l(i)*gs_rs(i)
10607 g_r = g_r + alpha_r(i)*gs_rs(i)
10608 end do
10609 ! Elastic contribution to energy if G large enough
10610 if (g_l > verysmall .and. g_r > verysmall) then
10611 e_l = e_l + g_l*ql_prim_rsy_vf(j, k, l, xiend + 1)
10612 e_r = e_r + g_r*qr_prim_rsy_vf(j + 1, k, l, xiend + 1)
10613 end if
10614
10615# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10616#if defined(MFC_OpenACC)
10617# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10618!$acc loop seq
10619# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10620#elif defined(MFC_OpenMP)
10621# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10622
10623# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10624#endif
10625 do i = 1, b_size - 1
10626 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
10627 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
10628 end do
10629 end if
10630
10631 h_l = (e_l + pres_l)/rho_l
10632 h_r = (e_r + pres_r)/rho_r
10633
10634
10635# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10636 if (avg_state == 1) then
10637# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10638
10639# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10640 rho_avg = sqrt(rho_l*rho_r)
10641# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10642
10643# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10644 vel_avg_rms = 0._wp
10645# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10646
10647# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10648
10649# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10650#if defined(MFC_OpenACC)
10651# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10652!$acc loop seq
10653# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10654#elif defined(MFC_OpenMP)
10655# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10656
10657# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10658#endif
10659# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10660 do i = 1, num_vels
10661# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10662 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
10663# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10664 (sqrt(rho_l) + sqrt(rho_r))**2._wp
10665# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10666 end do
10667# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10668
10669# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10670 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
10671# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10672 (sqrt(rho_l) + sqrt(rho_r))
10673# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10674
10675# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10676 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
10677# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10678 (sqrt(rho_l) + sqrt(rho_r))
10679# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10680
10681# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10682 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
10683# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10684 (sqrt(rho_l) + sqrt(rho_r))**2._wp
10685# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10686
10687# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10688 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
10689# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10690 (sqrt(rho_l) + sqrt(rho_r))
10691# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10692
10693# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10694 if (chemistry) then
10695# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10696 eps = 0.001_wp
10697# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10698 call get_species_enthalpies_rt(t_l, h_il)
10699# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10700 call get_species_enthalpies_rt(t_r, h_ir)
10701# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10702 h_il = h_il*gas_constant/molecular_weights*t_l
10703# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10704 h_ir = h_ir*gas_constant/molecular_weights*t_r
10705# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10706 call get_species_specific_heats_r(t_l, cp_il)
10707# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10708 call get_species_specific_heats_r(t_r, cp_ir)
10709# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10710
10711# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10712 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
10713# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10714 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
10715# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10716 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
10717# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10718 if (abs(t_l - t_r) < eps) then
10719# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10720 ! Case when T_L and T_R are very close
10721# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10722 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
10723# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10724 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
10725# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10726 else
10727# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10728 ! Normal calculation when T_L and T_R are sufficiently different
10729# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10730 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
10731# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10732 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
10733# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10734 end if
10735# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10736 gamma_avg = cp_avg/cv_avg
10737# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10738
10739# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10740 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
10741# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10742 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
10743# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10744
10745# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10746 end if
10747# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10748
10749# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10750 end if
10751# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10752
10753# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10754 if (avg_state == 2) then
10755# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10756 rho_avg = 5.e-1_wp*(rho_l + rho_r)
10757# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10758 vel_avg_rms = 0._wp
10759# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10760
10761# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10762#if defined(MFC_OpenACC)
10763# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10764!$acc loop seq
10765# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10766#elif defined(MFC_OpenMP)
10767# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10768
10769# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10770#endif
10771# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10772 do i = 1, num_vels
10773# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10774 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
10775# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10776 end do
10777# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10778
10779# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10780 h_avg = 5.e-1_wp*(h_l + h_r)
10781# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10782 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
10783# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10784 qv_avg = 5.e-1_wp*(qv_l + qv_r)
10785# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10786
10787# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10788 end if
10789# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10790
10791
10792 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
10793 vel_l_rms, 0._wp, c_l, qv_l)
10794
10795 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
10796 vel_r_rms, 0._wp, c_r, qv_r)
10797
10798 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
10799 ! variables are placeholders to call the subroutine.
10800 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
10801 vel_avg_rms, 0._wp, c_avg, qv_avg)
10802
10803 if (viscous) then
10804
10805# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10806#if defined(MFC_OpenACC)
10807# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10808!$acc loop seq
10809# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10810#elif defined(MFC_OpenMP)
10811# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10812
10813# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10814#endif
10815 do i = 1, 2
10816 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
10817 end do
10818 end if
10819
10820 ! Low Mach correction
10821 if (low_mach == 2) then
10822
10823# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10824 if (riemann_solver == 1 .or. riemann_solver == 5) then
10825# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10826
10827# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10828 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
10829# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10830 pcorr = 0._wp
10831# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10832
10833# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10834 if (low_mach == 1) then
10835# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10836 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
10837# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10838 end if
10839# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10840
10841# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10842 else if (riemann_solver == 2) then
10843# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10844 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
10845# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10846 pcorr = 0._wp
10847# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10848
10849# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10850 if (low_mach == 1) then
10851# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10852 pcorr = rho_l*rho_r* &
10853# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10854 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
10855# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10856 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
10857# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10858 (zcoef - 1._wp)
10859# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10860 else if (low_mach == 2) then
10861# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10862 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))))
10863# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10864 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))))
10865# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10866 vel_l(dir_idx(1)) = vel_l_tmp
10867# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10868 vel_r(dir_idx(1)) = vel_r_tmp
10869# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10870 end if
10871# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10872 end if
10873# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10874
10875 end if
10876
10877 ! COMPUTING THE DIRECT WAVE SPEEDS
10878 if (wave_speeds == 1) then
10879 if (elasticity) then
10880 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
10881 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l), vel_r(dir_idx(1)) - sqrt(c_r*c_r + &
10882 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r))
10883 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
10884 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r), vel_l(dir_idx(1)) + sqrt(c_l*c_l + &
10885 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l))
10886 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + &
10887 tau_e_l(dir_idx_tau(1)) + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - &
10888 rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - &
10889 rho_r*(s_r - vel_r(dir_idx(1))))
10890 else
10891 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
10892 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
10893 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
10894 (s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1)))) &
10895 /(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
10896
10897 end if
10898 elseif (wave_speeds == 2) then
10899 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
10900 (vel_l(dir_idx(1)) - &
10901 vel_r(dir_idx(1))))
10902
10903 pres_sr = pres_sl
10904
10905 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
10906 (pres_sl/pres_l - 1._wp)*pres_l/ &
10907 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
10908 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
10909 (pres_sr/pres_r - 1._wp)*pres_r/ &
10910 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
10911
10912 s_l = vel_l(dir_idx(1)) - c_l*ms_l
10913 s_r = vel_r(dir_idx(1)) + c_r*ms_r
10914
10915 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
10916 (pres_l - pres_r)/ &
10917 (rho_avg*c_avg))
10918 end if
10919
10920 ! follows Einfeldt et al.
10921 ! s_M/P = min/max(0.,s_L/R)
10922 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
10923
10924 ! goes with q_star_L/R = xi_L/R * (variable)
10925 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
10926 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
10927 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
10928
10929 ! goes with numerical star velocity in x/y/z directions
10930 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
10931 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
10932 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
10933
10934 ! goes with the numerical velocity in x/y/z directions
10935 ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
10936 xi_mp = -min(0._wp, sign(1._wp, s_l))
10937 xi_pp = max(0._wp, sign(1._wp, s_r))
10938
10939 e_star = xi_m*(e_l + xi_mp*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
10940 (rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1))))) - e_l)) + &
10941 xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
10942 (rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
10943 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) + &
10944 xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
10945
10946 rho_star = xi_m*(rho_l*(xi_mp*xi_l + 1._wp - xi_mp)) + &
10947 xi_p*(rho_r*(xi_pp*xi_r + 1._wp - xi_pp))
10948
10949 vel_k_star = vel_l(dir_idx(1))*(1._wp - xi_mp) + xi_mp*vel_r(dir_idx(1)) + &
10950 xi_mp*xi_pp*(s_s - vel_r(dir_idx(1)))
10951
10952 ! Low Mach correction
10953 if (low_mach == 1) then
10954
10955# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10956 if (riemann_solver == 1 .or. riemann_solver == 5) then
10957# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10958
10959# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10960 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
10961# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10962 pcorr = 0._wp
10963# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10964
10965# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10966 if (low_mach == 1) then
10967# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10968 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
10969# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10970 end if
10971# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10972
10973# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10974 else if (riemann_solver == 2) then
10975# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10976 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
10977# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10978 pcorr = 0._wp
10979# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10980
10981# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10982 if (low_mach == 1) then
10983# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10984 pcorr = rho_l*rho_r* &
10985# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10986 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
10987# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10988 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
10989# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10990 (zcoef - 1._wp)
10991# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10992 else if (low_mach == 2) then
10993# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10994 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))))
10995# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10996 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))))
10997# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
10998 vel_l(dir_idx(1)) = vel_l_tmp
10999# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11000 vel_r(dir_idx(1)) = vel_r_tmp
11001# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11002 end if
11003# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11004 end if
11005# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11006
11007 else
11008 pcorr = 0._wp
11009 end if
11010
11011 ! COMPUTING FLUXES
11012 ! MASS FLUX.
11013
11014# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11015#if defined(MFC_OpenACC)
11016# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11017!$acc loop seq
11018# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11019#elif defined(MFC_OpenMP)
11020# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11021
11022# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11023#endif
11024 do i = 1, contxe
11025 flux_rsy_vf(j, k, l, i) = &
11026 xi_m*ql_prim_rsy_vf(j, k, l, i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + &
11027 xi_p*qr_prim_rsy_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11028 end do
11029
11030 ! MOMENTUM FLUX.
11031 ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
11032
11033# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11034#if defined(MFC_OpenACC)
11035# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11036!$acc loop seq
11037# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11038#elif defined(MFC_OpenMP)
11039# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11040
11041# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11042#endif
11043 do i = 1, num_dims
11044 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = rho_star*vel_k_star* &
11045 (dir_flg(dir_idx(i))*vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star &
11046 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
11047 end do
11048
11049 ! ENERGY FLUX.
11050 ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
11051 flux_rsy_vf(j, k, l, e_idx) = (e_star + p_star)*vel_k_star &
11052 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
11053
11054 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
11055 if (elasticity) then
11056 flux_ene_e = 0._wp;
11057
11058# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11059#if defined(MFC_OpenACC)
11060# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11061!$acc loop seq
11062# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11063#elif defined(MFC_OpenMP)
11064# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11065
11066# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11067#endif
11068 do i = 1, num_dims
11069 ! MOMENTUM ELASTIC FLUX.
11070 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
11071 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) &
11072 - xi_m*tau_e_l(dir_idx_tau(i)) - xi_p*tau_e_r(dir_idx_tau(i))
11073 ! ENERGY ELASTIC FLUX.
11074 flux_ene_e = flux_ene_e - &
11075 xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) + &
11076 s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i))/(s_l - vel_l(i)))))) - &
11077 xi_p*(vel_r(dir_idx(i))*tau_e_r(dir_idx_tau(i)) + &
11078 s_p*(xi_r*((s_s - vel_r(i))*(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
11079 end do
11080 flux_rsy_vf(j, k, l, e_idx) = flux_rsy_vf(j, k, l, e_idx) + flux_ene_e
11081 end if
11082
11083 ! VOLUME FRACTION FLUX.
11084
11085# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11086#if defined(MFC_OpenACC)
11087# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11088!$acc loop seq
11089# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11090#elif defined(MFC_OpenMP)
11091# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11092
11093# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11094#endif
11095 do i = advxb, advxe
11096 flux_rsy_vf(j, k, l, i) = &
11097 xi_m*ql_prim_rsy_vf(j, k, l, i)*s_s + &
11098 xi_p*qr_prim_rsy_vf(j + 1, k, l, i)*s_s
11099 end do
11100
11101 ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX.
11102
11103# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11104#if defined(MFC_OpenACC)
11105# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11106!$acc loop seq
11107# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11108#elif defined(MFC_OpenMP)
11109# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11110
11111# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11112#endif
11113 do i = 1, num_dims
11114 vel_src_rsy_vf(j, k, l, dir_idx(i)) = &
11115 xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(s_s*(xi_mp*(xi_l - 1) + 1) - vel_l(dir_idx(i)))) + &
11116 xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(s_s*(xi_pp*(xi_r - 1) + 1) - vel_r(dir_idx(i))))
11117 end do
11118
11119 ! INTERNAL ENERGIES ADVECTION FLUX.
11120 ! K-th pressure and velocity in preparation for the internal energy flux
11121
11122# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11123#if defined(MFC_OpenACC)
11124# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11125!$acc loop seq
11126# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11127#elif defined(MFC_OpenMP)
11128# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11129
11130# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11131#endif
11132 do i = 1, num_fluids
11133 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))* &
11134 xi_l**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) + &
11135 xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i)))* &
11136 xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) + pres_r)
11137
11138 flux_rsy_vf(j, k, l, i + intxb - 1) = &
11139 ((xi_m*ql_prim_rsy_vf(j, k, l, i + advxb - 1) + xi_p*qr_prim_rsy_vf(j + 1, k, l, i + advxb - 1))* &
11140 (gammas(i)*p_k_star + pi_infs(i)) + &
11141 (xi_m*ql_prim_rsy_vf(j, k, l, i + contxb - 1) + xi_p*qr_prim_rsy_vf(j + 1, k, l, i + contxb - 1))* &
11142 qvs(i))*vel_k_star &
11143 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s*(xi_m*ql_prim_rsy_vf(j, k, l, i + advxb - 1) + xi_p*qr_prim_rsy_vf(j + 1, k, l, i + advxb - 1))
11144 end do
11145
11146 flux_src_rsy_vf(j, k, l, advxb) = vel_src_rsy_vf(j, k, l, dir_idx(1))
11147
11148 ! HYPOELASTIC STRESS EVOLUTION FLUX.
11149 if (hypoelasticity) then
11150
11151# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11152#if defined(MFC_OpenACC)
11153# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11154!$acc loop seq
11155# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11156#elif defined(MFC_OpenMP)
11157# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11158
11159# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11160#endif
11161 do i = 1, strxe - strxb + 1
11162 flux_rsy_vf(j, k, l, strxb - 1 + i) = &
11163 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + &
11164 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
11165 end do
11166 end if
11167
11168 ! REFERENCE MAP FLUX.
11169 if (hyperelasticity) then
11170
11171# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11172#if defined(MFC_OpenACC)
11173# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11174!$acc loop seq
11175# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11176#elif defined(MFC_OpenMP)
11177# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11178
11179# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11180#endif
11181 do i = 1, num_dims
11182 flux_rsy_vf(j, k, l, xibeg - 1 + i) = &
11183 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
11184 - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + &
11185 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
11186 - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
11187 end do
11188 end if
11189
11190 ! COLOR FUNCTION FLUX
11191 if (surface_tension) then
11192 flux_rsy_vf(j, k, l, c_idx) = &
11193 (xi_m*ql_prim_rsy_vf(j, k, l, c_idx) + &
11194 xi_p*qr_prim_rsy_vf(j + 1, k, l, c_idx))*s_s
11195 end if
11196
11197 ! Geometrical source flux for cylindrical coordinates
11198# 2458 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11199 if (cyl_coord) then
11200 !Substituting the advective flux into the inviscid geometrical source flux
11201
11202# 2460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11203#if defined(MFC_OpenACC)
11204# 2460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11205!$acc loop seq
11206# 2460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11207#elif defined(MFC_OpenMP)
11208# 2460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11209
11210# 2460 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11211#endif
11212 do i = 1, e_idx
11213 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
11214 end do
11215
11216# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11217#if defined(MFC_OpenACC)
11218# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11219!$acc loop seq
11220# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11221#elif defined(MFC_OpenMP)
11222# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11223
11224# 2464 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11225#endif
11226 do i = intxb, intxe
11227 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
11228 end do
11229 ! Recalculating the radial momentum geometric source flux
11230 flux_gsrc_rsy_vf(j, k, l, momxb - 1 + dir_idx(1)) = &
11231 flux_gsrc_rsy_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_star
11232 ! Geometrical source of the void fraction(s) is zero
11233
11234# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11235#if defined(MFC_OpenACC)
11236# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11237!$acc loop seq
11238# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11239#elif defined(MFC_OpenMP)
11240# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11241
11242# 2472 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11243#endif
11244 do i = advxb, advxe
11245 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
11246 end do
11247 end if
11248# 2478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11249# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11250
11251 end do
11252 end do
11253 end do
11254
11255# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11256
11257# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11258#if defined(MFC_OpenACC)
11259# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11260!$acc end parallel loop
11261# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11262#elif defined(MFC_OpenMP)
11263# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11264
11265# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11266
11267# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11268!$omp end target teams loop
11269# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11270#endif
11271# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11272
11273
11274 elseif (model_eqns == 4) then
11275 !ME4
11276
11277# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11278
11279# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11280#if defined(MFC_OpenACC)
11281# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11282!$acc parallel loop collapse(3) gang vector default(present) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
11283# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11284#elif defined(MFC_OpenMP)
11285# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11286
11287# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11288
11289# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11290
11291# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11292!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
11293# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11294#endif
11295# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11296
11297 do l = is3%beg, is3%end
11298 do k = is2%beg, is2%end
11299 do j = is1%beg, is1%end
11300
11301 vel_l_rms = 0._wp; vel_r_rms = 0._wp
11302 rho_l = 0._wp; rho_r = 0._wp
11303 gamma_l = 0._wp; gamma_r = 0._wp
11304 pi_inf_l = 0._wp; pi_inf_r = 0._wp
11305 qv_l = 0._wp; qv_r = 0._wp
11306
11307
11308# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11309#if defined(MFC_OpenACC)
11310# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11311!$acc loop seq
11312# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11313#elif defined(MFC_OpenMP)
11314# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11315
11316# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11317#endif
11318 do i = 1, contxe
11319 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
11320 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
11321 end do
11322
11323
11324# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11325#if defined(MFC_OpenACC)
11326# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11327!$acc loop seq
11328# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11329#elif defined(MFC_OpenMP)
11330# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11331
11332# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11333#endif
11334 do i = 1, num_dims
11335 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
11336 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
11337 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
11338 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
11339 end do
11340
11341
11342# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11343#if defined(MFC_OpenACC)
11344# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11345!$acc loop seq
11346# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11347#elif defined(MFC_OpenMP)
11348# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11349
11350# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11351#endif
11352 do i = 1, num_fluids
11353 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
11354 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
11355 end do
11356
11357# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11358#if defined(MFC_OpenACC)
11359# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11360!$acc loop seq
11361# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11362#elif defined(MFC_OpenMP)
11363# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11364
11365# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11366#endif
11367 do i = 1, num_fluids
11368 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
11369 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
11370 end do
11371
11372
11373# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11374#if defined(MFC_OpenACC)
11375# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11376!$acc loop seq
11377# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11378#elif defined(MFC_OpenMP)
11379# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11380
11381# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11382#endif
11383 do i = 1, num_fluids
11384 rho_l = rho_l + alpha_rho_l(i)
11385 gamma_l = gamma_l + alpha_l(i)*gammas(i)
11386 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
11387 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
11388
11389 rho_r = rho_r + alpha_rho_r(i)
11390 gamma_r = gamma_r + alpha_r(i)*gammas(i)
11391 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
11392 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
11393 end do
11394
11395 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
11396 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
11397
11398 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
11399 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
11400
11401 h_l = (e_l + pres_l)/rho_l
11402 h_r = (e_r + pres_r)/rho_r
11403
11404
11405# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11406 if (avg_state == 1) then
11407# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11408
11409# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11410 rho_avg = sqrt(rho_l*rho_r)
11411# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11412
11413# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11414 vel_avg_rms = 0._wp
11415# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11416
11417# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11418
11419# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11420#if defined(MFC_OpenACC)
11421# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11422!$acc loop seq
11423# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11424#elif defined(MFC_OpenMP)
11425# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11426
11427# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11428#endif
11429# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11430 do i = 1, num_vels
11431# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11432 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
11433# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11434 (sqrt(rho_l) + sqrt(rho_r))**2._wp
11435# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11436 end do
11437# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11438
11439# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11440 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
11441# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11442 (sqrt(rho_l) + sqrt(rho_r))
11443# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11444
11445# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11446 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
11447# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11448 (sqrt(rho_l) + sqrt(rho_r))
11449# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11450
11451# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11452 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
11453# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11454 (sqrt(rho_l) + sqrt(rho_r))**2._wp
11455# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11456
11457# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11458 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
11459# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11460 (sqrt(rho_l) + sqrt(rho_r))
11461# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11462
11463# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11464 if (chemistry) then
11465# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11466 eps = 0.001_wp
11467# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11468 call get_species_enthalpies_rt(t_l, h_il)
11469# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11470 call get_species_enthalpies_rt(t_r, h_ir)
11471# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11472 h_il = h_il*gas_constant/molecular_weights*t_l
11473# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11474 h_ir = h_ir*gas_constant/molecular_weights*t_r
11475# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11476 call get_species_specific_heats_r(t_l, cp_il)
11477# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11478 call get_species_specific_heats_r(t_r, cp_ir)
11479# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11480
11481# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11482 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
11483# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11484 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
11485# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11486 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
11487# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11488 if (abs(t_l - t_r) < eps) then
11489# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11490 ! Case when T_L and T_R are very close
11491# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11492 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
11493# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11494 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
11495# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11496 else
11497# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11498 ! Normal calculation when T_L and T_R are sufficiently different
11499# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11500 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
11501# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11502 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
11503# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11504 end if
11505# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11506 gamma_avg = cp_avg/cv_avg
11507# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11508
11509# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11510 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
11511# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11512 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
11513# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11514
11515# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11516 end if
11517# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11518
11519# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11520 end if
11521# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11522
11523# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11524 if (avg_state == 2) then
11525# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11526 rho_avg = 5.e-1_wp*(rho_l + rho_r)
11527# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11528 vel_avg_rms = 0._wp
11529# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11530
11531# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11532#if defined(MFC_OpenACC)
11533# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11534!$acc loop seq
11535# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11536#elif defined(MFC_OpenMP)
11537# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11538
11539# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11540#endif
11541# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11542 do i = 1, num_vels
11543# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11544 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
11545# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11546 end do
11547# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11548
11549# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11550 h_avg = 5.e-1_wp*(h_l + h_r)
11551# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11552 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
11553# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11554 qv_avg = 5.e-1_wp*(qv_l + qv_r)
11555# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11556
11557# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11558 end if
11559# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11560
11561
11562 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
11563 vel_l_rms, 0._wp, c_l, qv_l)
11564
11565 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
11566 vel_r_rms, 0._wp, c_r, qv_r)
11567
11568 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
11569 ! variables are placeholders to call the subroutine.
11570
11571 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
11572 vel_avg_rms, 0._wp, c_avg, qv_avg)
11573
11574 if (wave_speeds == 1) then
11575 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
11576 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
11577
11578 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
11579 (s_l - vel_l(dir_idx(1))) - &
11580 rho_r*vel_r(dir_idx(1))* &
11581 (s_r - vel_r(dir_idx(1)))) &
11582 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
11583 rho_r*(s_r - vel_r(dir_idx(1))))
11584 elseif (wave_speeds == 2) then
11585 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
11586 (vel_l(dir_idx(1)) - &
11587 vel_r(dir_idx(1))))
11588
11589 pres_sr = pres_sl
11590
11591 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
11592 (pres_sl/pres_l - 1._wp)*pres_l/ &
11593 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
11594 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
11595 (pres_sr/pres_r - 1._wp)*pres_r/ &
11596 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
11597
11598 s_l = vel_l(dir_idx(1)) - c_l*ms_l
11599 s_r = vel_r(dir_idx(1)) + c_r*ms_r
11600
11601 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
11602 (pres_l - pres_r)/ &
11603 (rho_avg*c_avg))
11604 end if
11605
11606 ! follows Einfeldt et al.
11607 ! s_M/P = min/max(0.,s_L/R)
11608 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
11609
11610 ! goes with q_star_L/R = xi_L/R * (variable)
11611 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
11612 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
11613 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
11614
11615 ! goes with numerical velocity in x/y/z directions
11616 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
11617 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
11618 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
11619
11620
11621# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11622#if defined(MFC_OpenACC)
11623# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11624!$acc loop seq
11625# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11626#elif defined(MFC_OpenMP)
11627# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11628
11629# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11630#endif
11631 do i = 1, contxe
11632 flux_rsy_vf(j, k, l, i) = &
11633 xi_m*alpha_rho_l(i) &
11634 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
11635 + xi_p*alpha_rho_r(i) &
11636 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11637 end do
11638
11639 ! Momentum flux.
11640 ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
11641
11642# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11643#if defined(MFC_OpenACC)
11644# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11645!$acc loop seq
11646# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11647#elif defined(MFC_OpenMP)
11648# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11649
11650# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11651#endif
11652 do i = 1, num_dims
11653 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
11654 xi_m*(rho_l*(vel_l(dir_idx(1))* &
11655 vel_l(dir_idx(i)) + &
11656 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
11657 (1._wp - dir_flg(dir_idx(i)))* &
11658 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
11659 dir_flg(dir_idx(i))*pres_l) &
11660 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
11661 vel_r(dir_idx(i)) + &
11662 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
11663 (1._wp - dir_flg(dir_idx(i)))* &
11664 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
11665 dir_flg(dir_idx(i))*pres_r)
11666 end do
11667
11668 if (bubbles_euler) then
11669 ! Put p_tilde in
11670
11671# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11672#if defined(MFC_OpenACC)
11673# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11674!$acc loop seq
11675# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11676#elif defined(MFC_OpenMP)
11677# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11678
11679# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11680#endif
11681 do i = 1, num_dims
11682 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
11683 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) + &
11684 xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l)) &
11685 + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
11686 end do
11687 end if
11688
11689 flux_rsy_vf(j, k, l, e_idx) = 0._wp
11690
11691
11692# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11693#if defined(MFC_OpenACC)
11694# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11695!$acc loop seq
11696# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11697#elif defined(MFC_OpenMP)
11698# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11699
11700# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11701#endif
11702 do i = alf_idx, alf_idx !only advect the void fraction
11703 flux_rsy_vf(j, k, l, i) = &
11704 xi_m*ql_prim_rsy_vf(j, k, l, i) &
11705 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
11706 + xi_p*qr_prim_rsy_vf(j + 1, k, l, i) &
11707 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11708 end do
11709
11710 ! Source for volume fraction advection equation
11711
11712# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11713#if defined(MFC_OpenACC)
11714# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11715!$acc loop seq
11716# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11717#elif defined(MFC_OpenMP)
11718# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11719
11720# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11721#endif
11722 do i = 1, num_dims
11723
11724 vel_src_rsy_vf(j, k, l, dir_idx(i)) = 0._wp
11725 !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
11726 end do
11727
11728 flux_src_rsy_vf(j, k, l, advxb) = vel_src_rsy_vf(j, k, l, dir_idx(1))
11729
11730 ! Add advection flux for bubble variables
11731 if (bubbles_euler) then
11732
11733# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11734#if defined(MFC_OpenACC)
11735# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11736!$acc loop seq
11737# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11738#elif defined(MFC_OpenMP)
11739# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11740
11741# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11742#endif
11743 do i = bubxb, bubxe
11744 flux_rsy_vf(j, k, l, i) = &
11745 xi_m*nbub_l*ql_prim_rsy_vf(j, k, l, i) &
11746 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
11747 + xi_p*nbub_r*qr_prim_rsy_vf(j + 1, k, l, i) &
11748 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
11749 end do
11750 end if
11751
11752 ! Geometrical source flux for cylindrical coordinates
11753
11754# 2691 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11755 if (cyl_coord) then
11756 ! Substituting the advective flux into the inviscid geometrical source flux
11757
11758# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11759#if defined(MFC_OpenACC)
11760# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11761!$acc loop seq
11762# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11763#elif defined(MFC_OpenMP)
11764# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11765
11766# 2693 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11767#endif
11768 do i = 1, e_idx
11769 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
11770 end do
11771 ! Recalculating the radial momentum geometric source flux
11772 flux_gsrc_rsy_vf(j, k, l, contxe + dir_idx(1)) = &
11773 xi_m*(rho_l*(vel_l(dir_idx(1))* &
11774 vel_l(dir_idx(1)) + &
11775 s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + &
11776 (1._wp - dir_flg(dir_idx(1)))* &
11777 vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
11778 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
11779 vel_r(dir_idx(1)) + &
11780 s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + &
11781 (1._wp - dir_flg(dir_idx(1)))* &
11782 vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
11783 ! Geometrical source of the void fraction(s) is zero
11784
11785# 2710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11786#if defined(MFC_OpenACC)
11787# 2710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11788!$acc loop seq
11789# 2710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11790#elif defined(MFC_OpenMP)
11791# 2710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11792
11793# 2710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11794#endif
11795 do i = advxb, advxe
11796 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
11797 end do
11798 end if
11799# 2716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11800# 2736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11801 end do
11802 end do
11803 end do
11804
11805# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11806
11807# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11808#if defined(MFC_OpenACC)
11809# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11810!$acc end parallel loop
11811# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11812#elif defined(MFC_OpenMP)
11813# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11814
11815# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11816
11817# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11818!$omp end target teams loop
11819# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11820#endif
11821# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11822
11823
11824 elseif (model_eqns == 2 .and. bubbles_euler) then
11825
11826# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11827
11828# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11829#if defined(MFC_OpenACC)
11830# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11831!$acc parallel loop collapse(3) gang vector default(present) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar)
11832# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11833#elif defined(MFC_OpenMP)
11834# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11835
11836# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11837
11838# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11839
11840# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11841!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar)
11842# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11843#endif
11844# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11845
11846 do l = is3%beg, is3%end
11847 do k = is2%beg, is2%end
11848 do j = is1%beg, is1%end
11849
11850 vel_l_rms = 0._wp; vel_r_rms = 0._wp
11851 rho_l = 0._wp; rho_r = 0._wp
11852 gamma_l = 0._wp; gamma_r = 0._wp
11853 pi_inf_l = 0._wp; pi_inf_r = 0._wp
11854 qv_l = 0._wp; qv_r = 0._wp
11855
11856
11857# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11858#if defined(MFC_OpenACC)
11859# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11860!$acc loop seq
11861# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11862#elif defined(MFC_OpenMP)
11863# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11864
11865# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11866#endif
11867 do i = 1, num_fluids
11868 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
11869 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
11870 end do
11871
11872 vel_l_rms = 0._wp; vel_r_rms = 0._wp
11873
11874
11875# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11876#if defined(MFC_OpenACC)
11877# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11878!$acc loop seq
11879# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11880#elif defined(MFC_OpenMP)
11881# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11882
11883# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11884#endif
11885 do i = 1, num_dims
11886 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
11887 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
11888 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
11889 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
11890 end do
11891
11892 ! Retain this in the refactor
11893 if (mpp_lim .and. (num_fluids > 2)) then
11894
11895# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11896#if defined(MFC_OpenACC)
11897# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11898!$acc loop seq
11899# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11900#elif defined(MFC_OpenMP)
11901# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11902
11903# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11904#endif
11905 do i = 1, num_fluids
11906 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
11907 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*gammas(i)
11908 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*pi_infs(i)
11909 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
11910 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
11911 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*gammas(i)
11912 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
11913 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
11914 end do
11915 else if (num_fluids > 2) then
11916
11917# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11918#if defined(MFC_OpenACC)
11919# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11920!$acc loop seq
11921# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11922#elif defined(MFC_OpenMP)
11923# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11924
11925# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11926#endif
11927 do i = 1, num_fluids - 1
11928 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
11929 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*gammas(i)
11930 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*pi_infs(i)
11931 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
11932 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
11933 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*gammas(i)
11934 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
11935 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
11936 end do
11937 else
11938 rho_l = ql_prim_rsy_vf(j, k, l, 1)
11939 gamma_l = gammas(1)
11940 pi_inf_l = pi_infs(1)
11941 qv_l = qvs(1)
11942 rho_r = qr_prim_rsy_vf(j + 1, k, l, 1)
11943 gamma_r = gammas(1)
11944 pi_inf_r = pi_infs(1)
11945 qv_r = qvs(1)
11946 end if
11947
11948 if (viscous) then
11949 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
11950
11951# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11952#if defined(MFC_OpenACC)
11953# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11954!$acc loop seq
11955# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11956#elif defined(MFC_OpenMP)
11957# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11958
11959# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11960#endif
11961 do i = 1, 2
11962 re_l(i) = dflt_real
11963 re_r(i) = dflt_real
11964
11965 if (re_size(i) > 0) re_l(i) = 0._wp
11966 if (re_size(i) > 0) re_r(i) = 0._wp
11967
11968
11969# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11970#if defined(MFC_OpenACC)
11971# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11972!$acc loop seq
11973# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11974#elif defined(MFC_OpenMP)
11975# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11976
11977# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
11978#endif
11979 do q = 1, re_size(i)
11980 re_l(i) = (1._wp - ql_prim_rsy_vf(j, k, l, e_idx + re_idx(i, q)))/res_gs(i, q) &
11981 + re_l(i)
11982 re_r(i) = (1._wp - qr_prim_rsy_vf(j + 1, k, l, e_idx + re_idx(i, q)))/res_gs(i, q) &
11983 + re_r(i)
11984 end do
11985
11986 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
11987 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
11988
11989 end do
11990 end if
11991 end if
11992
11993 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
11994 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
11995
11996 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
11997 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
11998
11999 h_l = (e_l + pres_l)/rho_l
12000 h_r = (e_r + pres_r)/rho_r
12001
12002 if (avg_state == 2) then
12003
12004# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12005#if defined(MFC_OpenACC)
12006# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12007!$acc loop seq
12008# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12009#elif defined(MFC_OpenMP)
12010# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12011
12012# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12013#endif
12014 do i = 1, nb
12015 r0_l(i) = ql_prim_rsy_vf(j, k, l, rs(i))
12016 r0_r(i) = qr_prim_rsy_vf(j + 1, k, l, rs(i))
12017
12018 v0_l(i) = ql_prim_rsy_vf(j, k, l, vs(i))
12019 v0_r(i) = qr_prim_rsy_vf(j + 1, k, l, vs(i))
12020 if (.not. polytropic .and. .not. qbmm) then
12021 p0_l(i) = ql_prim_rsy_vf(j, k, l, ps(i))
12022 p0_r(i) = qr_prim_rsy_vf(j + 1, k, l, ps(i))
12023 end if
12024 end do
12025
12026 if (.not. qbmm) then
12027 if (adv_n) then
12028 nbub_l = ql_prim_rsy_vf(j, k, l, n_idx)
12029 nbub_r = qr_prim_rsy_vf(j + 1, k, l, n_idx)
12030 else
12031 nbub_l = 0._wp
12032 nbub_r = 0._wp
12033
12034# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12035#if defined(MFC_OpenACC)
12036# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12037!$acc loop seq
12038# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12039#elif defined(MFC_OpenMP)
12040# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12041
12042# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12043#endif
12044 do i = 1, nb
12045 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
12046 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
12047 end do
12048
12049 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsy_vf(j, k, l, e_idx + num_fluids)/nbub_l
12050 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsy_vf(j + 1, k, l, e_idx + num_fluids)/nbub_r
12051 end if
12052 else
12053 !nb stored in 0th moment of first R0 bin in variable conversion module
12054 nbub_l = ql_prim_rsy_vf(j, k, l, bubxb)
12055 nbub_r = qr_prim_rsy_vf(j + 1, k, l, bubxb)
12056 end if
12057
12058
12059# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12060#if defined(MFC_OpenACC)
12061# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12062!$acc loop seq
12063# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12064#elif defined(MFC_OpenMP)
12065# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12066
12067# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12068#endif
12069 do i = 1, nb
12070 if (.not. qbmm) then
12071 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
12072 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
12073 end if
12074 end do
12075
12076 if (qbmm) then
12077 pbwr3lbar = mom_sp_rsy_vf(j, k, l, 4)
12078 pbwr3rbar = mom_sp_rsy_vf(j + 1, k, l, 4)
12079
12080 r3lbar = mom_sp_rsy_vf(j, k, l, 1)
12081 r3rbar = mom_sp_rsy_vf(j + 1, k, l, 1)
12082
12083 r3v2lbar = mom_sp_rsy_vf(j, k, l, 3)
12084 r3v2rbar = mom_sp_rsy_vf(j + 1, k, l, 3)
12085 else
12086
12087 pbwr3lbar = 0._wp
12088 pbwr3rbar = 0._wp
12089
12090 r3lbar = 0._wp
12091 r3rbar = 0._wp
12092
12093 r3v2lbar = 0._wp
12094 r3v2rbar = 0._wp
12095
12096
12097# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12098#if defined(MFC_OpenACC)
12099# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12100!$acc loop seq
12101# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12102#elif defined(MFC_OpenMP)
12103# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12104
12105# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12106#endif
12107 do i = 1, nb
12108 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
12109 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
12110
12111 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
12112 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
12113
12114 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
12115 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
12116 end do
12117 end if
12118
12119 rho_avg = 5.e-1_wp*(rho_l + rho_r)
12120 h_avg = 5.e-1_wp*(h_l + h_r)
12121 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
12122 qv_avg = 5.e-1_wp*(qv_l + qv_r)
12123 vel_avg_rms = 0._wp
12124
12125
12126# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12127#if defined(MFC_OpenACC)
12128# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12129!$acc loop seq
12130# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12131#elif defined(MFC_OpenMP)
12132# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12133
12134# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12135#endif
12136 do i = 1, num_dims
12137 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
12138 end do
12139
12140 end if
12141
12142 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
12143 vel_l_rms, 0._wp, c_l, qv_l)
12144
12145 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
12146 vel_r_rms, 0._wp, c_r, qv_r)
12147
12148 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
12149 ! variables are placeholders to call the subroutine.
12150 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
12151 vel_avg_rms, 0._wp, c_avg, qv_avg)
12152
12153 if (viscous) then
12154
12155# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12156#if defined(MFC_OpenACC)
12157# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12158!$acc loop seq
12159# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12160#elif defined(MFC_OpenMP)
12161# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12162
12163# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12164#endif
12165 do i = 1, 2
12166 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
12167 end do
12168 end if
12169
12170 ! Low Mach correction
12171 if (low_mach == 2) then
12172
12173# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12174 if (riemann_solver == 1 .or. riemann_solver == 5) then
12175# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12176
12177# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12178 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12179# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12180 pcorr = 0._wp
12181# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12182
12183# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12184 if (low_mach == 1) then
12185# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12186 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12187# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12188 end if
12189# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12190
12191# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12192 else if (riemann_solver == 2) then
12193# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12194 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12195# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12196 pcorr = 0._wp
12197# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12198
12199# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12200 if (low_mach == 1) then
12201# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12202 pcorr = rho_l*rho_r* &
12203# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12204 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
12205# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12206 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
12207# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12208 (zcoef - 1._wp)
12209# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12210 else if (low_mach == 2) then
12211# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12212 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))))
12213# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12214 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))))
12215# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12216 vel_l(dir_idx(1)) = vel_l_tmp
12217# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12218 vel_r(dir_idx(1)) = vel_r_tmp
12219# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12220 end if
12221# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12222 end if
12223# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12224
12225 end if
12226
12227 if (wave_speeds == 1) then
12228 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
12229 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
12230
12231 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
12232 (s_l - vel_l(dir_idx(1))) - &
12233 rho_r*vel_r(dir_idx(1))* &
12234 (s_r - vel_r(dir_idx(1)))) &
12235 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
12236 rho_r*(s_r - vel_r(dir_idx(1))))
12237 elseif (wave_speeds == 2) then
12238 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
12239 (vel_l(dir_idx(1)) - &
12240 vel_r(dir_idx(1))))
12241
12242 pres_sr = pres_sl
12243
12244 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
12245 (pres_sl/pres_l - 1._wp)*pres_l/ &
12246 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
12247 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
12248 (pres_sr/pres_r - 1._wp)*pres_r/ &
12249 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
12250
12251 s_l = vel_l(dir_idx(1)) - c_l*ms_l
12252 s_r = vel_r(dir_idx(1)) + c_r*ms_r
12253
12254 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
12255 (pres_l - pres_r)/ &
12256 (rho_avg*c_avg))
12257 end if
12258
12259 ! follows Einfeldt et al.
12260 ! s_M/P = min/max(0.,s_L/R)
12261 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
12262
12263 ! goes with q_star_L/R = xi_L/R * (variable)
12264 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
12265 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
12266 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
12267
12268 ! goes with numerical velocity in x/y/z directions
12269 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
12270 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
12271 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
12272
12273 ! Low Mach correction
12274 if (low_mach == 1) then
12275
12276# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12277 if (riemann_solver == 1 .or. riemann_solver == 5) then
12278# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12279
12280# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12281 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12282# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12283 pcorr = 0._wp
12284# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12285
12286# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12287 if (low_mach == 1) then
12288# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12289 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
12290# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12291 end if
12292# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12293
12294# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12295 else if (riemann_solver == 2) then
12296# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12297 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
12298# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12299 pcorr = 0._wp
12300# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12301
12302# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12303 if (low_mach == 1) then
12304# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12305 pcorr = rho_l*rho_r* &
12306# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12307 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
12308# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12309 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
12310# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12311 (zcoef - 1._wp)
12312# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12313 else if (low_mach == 2) then
12314# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12315 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))))
12316# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12317 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))))
12318# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12319 vel_l(dir_idx(1)) = vel_l_tmp
12320# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12321 vel_r(dir_idx(1)) = vel_r_tmp
12322# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12323 end if
12324# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12325 end if
12326# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12327
12328 else
12329 pcorr = 0._wp
12330 end if
12331
12332
12333# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12334#if defined(MFC_OpenACC)
12335# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12336!$acc loop seq
12337# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12338#elif defined(MFC_OpenMP)
12339# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12340
12341# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12342#endif
12343 do i = 1, contxe
12344 flux_rsy_vf(j, k, l, i) = &
12345 xi_m*ql_prim_rsy_vf(j, k, l, i) &
12346 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12347 + xi_p*qr_prim_rsy_vf(j + 1, k, l, i) &
12348 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12349 end do
12350
12351 if (bubbles_euler .and. (num_fluids > 1)) then
12352 ! Kill mass transport @ gas density
12353 flux_rsy_vf(j, k, l, contxe) = 0._wp
12354 end if
12355
12356 ! Momentum flux.
12357 ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
12358
12359 ! Include p_tilde
12360
12361 if (avg_state == 2) then
12362 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
12363 pres_l = pres_l - alpha_l(num_fluids)*pres_l
12364 else
12365 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - &
12366 rho_l*r3v2lbar/r3lbar)
12367 end if
12368
12369 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
12370 pres_r = pres_r - alpha_r(num_fluids)*pres_r
12371 else
12372 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - &
12373 rho_r*r3v2rbar/r3rbar)
12374 end if
12375 end if
12376
12377
12378# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12379#if defined(MFC_OpenACC)
12380# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12381!$acc loop seq
12382# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12383#elif defined(MFC_OpenMP)
12384# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12385
12386# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12387#endif
12388 do i = 1, num_dims
12389 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
12390 xi_m*(rho_l*(vel_l(dir_idx(1))* &
12391 vel_l(dir_idx(i)) + &
12392 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
12393 (1._wp - dir_flg(dir_idx(i)))* &
12394 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
12395 dir_flg(dir_idx(i))*(pres_l)) &
12396 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
12397 vel_r(dir_idx(i)) + &
12398 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
12399 (1._wp - dir_flg(dir_idx(i)))* &
12400 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
12401 dir_flg(dir_idx(i))*(pres_r)) &
12402 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
12403 end do
12404
12405 ! Energy flux.
12406 ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
12407 flux_rsy_vf(j, k, l, e_idx) = &
12408 xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + &
12409 s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
12410 (rho_l*s_s + (pres_l)/ &
12411 (s_l - vel_l(dir_idx(1))))) - e_l)) &
12412 + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + &
12413 s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
12414 (rho_r*s_s + (pres_r)/ &
12415 (s_r - vel_r(dir_idx(1))))) - e_r)) &
12416 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
12417
12418 ! Volume fraction flux
12419
12420# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12421#if defined(MFC_OpenACC)
12422# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12423!$acc loop seq
12424# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12425#elif defined(MFC_OpenMP)
12426# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12427
12428# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12429#endif
12430 do i = advxb, advxe
12431 flux_rsy_vf(j, k, l, i) = &
12432 xi_m*ql_prim_rsy_vf(j, k, l, i) &
12433 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12434 + xi_p*qr_prim_rsy_vf(j + 1, k, l, i) &
12435 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12436 end do
12437
12438 ! Source for volume fraction advection equation
12439
12440# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12441#if defined(MFC_OpenACC)
12442# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12443!$acc loop seq
12444# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12445#elif defined(MFC_OpenMP)
12446# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12447
12448# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12449#endif
12450 do i = 1, num_dims
12451 vel_src_rsy_vf(j, k, l, dir_idx(i)) = &
12452 xi_m*(vel_l(dir_idx(i)) + &
12453 dir_flg(dir_idx(i))* &
12454 s_m*(xi_l - 1._wp)) &
12455 + xi_p*(vel_r(dir_idx(i)) + &
12456 dir_flg(dir_idx(i))* &
12457 s_p*(xi_r - 1._wp))
12458
12459 !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
12460 end do
12461
12462 flux_src_rsy_vf(j, k, l, advxb) = vel_src_rsy_vf(j, k, l, dir_idx(1))
12463
12464 ! Add advection flux for bubble variables
12465
12466# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12467#if defined(MFC_OpenACC)
12468# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12469!$acc loop seq
12470# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12471#elif defined(MFC_OpenMP)
12472# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12473
12474# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12475#endif
12476 do i = bubxb, bubxe
12477 flux_rsy_vf(j, k, l, i) = &
12478 xi_m*nbub_l*ql_prim_rsy_vf(j, k, l, i) &
12479 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12480 + xi_p*nbub_r*qr_prim_rsy_vf(j + 1, k, l, i) &
12481 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12482 end do
12483
12484 if (qbmm) then
12485 flux_rsy_vf(j, k, l, bubxb) = &
12486 xi_m*nbub_l &
12487 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12488 + xi_p*nbub_r &
12489 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12490 end if
12491
12492 if (adv_n) then
12493 flux_rsy_vf(j, k, l, n_idx) = &
12494 xi_m*nbub_l &
12495 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
12496 + xi_p*nbub_r &
12497 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
12498 end if
12499
12500 ! Geometrical source flux for cylindrical coordinates
12501# 3125 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12502 if (cyl_coord) then
12503 ! Substituting the advective flux into the inviscid geometrical source flux
12504
12505# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12506#if defined(MFC_OpenACC)
12507# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12508!$acc loop seq
12509# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12510#elif defined(MFC_OpenMP)
12511# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12512
12513# 3127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12514#endif
12515 do i = 1, e_idx
12516 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
12517 end do
12518 ! Recalculating the radial momentum geometric source flux
12519 flux_gsrc_rsy_vf(j, k, l, contxe + dir_idx(1)) = &
12520 xi_m*(rho_l*(vel_l(dir_idx(1))* &
12521 vel_l(dir_idx(1)) + &
12522 s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + &
12523 (1._wp - dir_flg(dir_idx(1)))* &
12524 vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
12525 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
12526 vel_r(dir_idx(1)) + &
12527 s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + &
12528 (1._wp - dir_flg(dir_idx(1)))* &
12529 vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
12530 ! Geometrical source of the void fraction(s) is zero
12531
12532# 3144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12533#if defined(MFC_OpenACC)
12534# 3144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12535!$acc loop seq
12536# 3144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12537#elif defined(MFC_OpenMP)
12538# 3144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12539
12540# 3144 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12541#endif
12542 do i = advxb, advxe
12543 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
12544 end do
12545 end if
12546# 3150 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12547# 3172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12548 end do
12549 end do
12550 end do
12551
12552# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12553
12554# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12555#if defined(MFC_OpenACC)
12556# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12557!$acc end parallel loop
12558# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12559#elif defined(MFC_OpenMP)
12560# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12561
12562# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12563
12564# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12565!$omp end target teams loop
12566# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12567#endif
12568# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12569
12570 else
12571 ! 5-EQUATION MODEL WITH HLLC
12572
12573# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12574
12575# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12576#if defined(MFC_OpenACC)
12577# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12578!$acc parallel loop collapse(3) gang vector default(present) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) copyin(is1, is2, is3)
12579# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12580#elif defined(MFC_OpenMP)
12581# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12582
12583# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12584
12585# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12586
12587# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12588!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) map(to:is1, is2, is3)
12589# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12590#endif
12591# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12592
12593 do l = is3%beg, is3%end
12594 do k = is2%beg, is2%end
12595 do j = is1%beg, is1%end
12596
12597 vel_l_rms = 0._wp; vel_r_rms = 0._wp
12598 rho_l = 0._wp; rho_r = 0._wp
12599 gamma_l = 0._wp; gamma_r = 0._wp
12600 pi_inf_l = 0._wp; pi_inf_r = 0._wp
12601 qv_l = 0._wp; qv_r = 0._wp
12602 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
12603
12604
12605# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12606#if defined(MFC_OpenACC)
12607# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12608!$acc loop seq
12609# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12610#elif defined(MFC_OpenMP)
12611# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12612
12613# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12614#endif
12615 do i = 1, num_fluids
12616 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
12617 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
12618 end do
12619
12620
12621# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12622#if defined(MFC_OpenACC)
12623# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12624!$acc loop seq
12625# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12626#elif defined(MFC_OpenMP)
12627# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12628
12629# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12630#endif
12631 do i = 1, num_dims
12632 vel_l(i) = ql_prim_rsy_vf(j, k, l, contxe + i)
12633 vel_r(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + i)
12634 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
12635 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
12636 end do
12637
12638 pres_l = ql_prim_rsy_vf(j, k, l, e_idx)
12639 pres_r = qr_prim_rsy_vf(j + 1, k, l, e_idx)
12640
12641 ! Change this by splitting it into the cases
12642 ! present in the bubbles_euler
12643 if (mpp_lim) then
12644
12645# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12646#if defined(MFC_OpenACC)
12647# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12648!$acc loop seq
12649# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12650#elif defined(MFC_OpenMP)
12651# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12652
12653# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12654#endif
12655 do i = 1, num_fluids
12656 ql_prim_rsy_vf(j, k, l, i) = max(0._wp, ql_prim_rsy_vf(j, k, l, i))
12657 ql_prim_rsy_vf(j, k, l, e_idx + i) = min(max(0._wp, ql_prim_rsy_vf(j, k, l, e_idx + i)), 1._wp)
12658 qr_prim_rsy_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsy_vf(j + 1, k, l, i))
12659 qr_prim_rsy_vf(j + 1, k, l, e_idx + i) = min(max(0._wp, qr_prim_rsy_vf(j + 1, k, l, e_idx + i)), 1._wp)
12660 alpha_l_sum = alpha_l_sum + ql_prim_rsy_vf(j, k, l, e_idx + i)
12661 alpha_r_sum = alpha_r_sum + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
12662 end do
12663
12664
12665# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12666#if defined(MFC_OpenACC)
12667# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12668!$acc loop seq
12669# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12670#elif defined(MFC_OpenMP)
12671# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12672
12673# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12674#endif
12675 do i = 1, num_fluids
12676 ql_prim_rsy_vf(j, k, l, e_idx + i) = ql_prim_rsy_vf(j, k, l, e_idx + i)/max(alpha_l_sum, sgm_eps)
12677 qr_prim_rsy_vf(j + 1, k, l, e_idx + i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)/max(alpha_r_sum, sgm_eps)
12678 end do
12679 end if
12680
12681
12682# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12683#if defined(MFC_OpenACC)
12684# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12685!$acc loop seq
12686# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12687#elif defined(MFC_OpenMP)
12688# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12689
12690# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12691#endif
12692 do i = 1, num_fluids
12693 rho_l = rho_l + ql_prim_rsy_vf(j, k, l, i)
12694 gamma_l = gamma_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*gammas(i)
12695 pi_inf_l = pi_inf_l + ql_prim_rsy_vf(j, k, l, e_idx + i)*pi_infs(i)
12696 qv_l = qv_l + ql_prim_rsy_vf(j, k, l, i)*qvs(i)
12697
12698 rho_r = rho_r + qr_prim_rsy_vf(j + 1, k, l, i)
12699 gamma_r = gamma_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*gammas(i)
12700 pi_inf_r = pi_inf_r + qr_prim_rsy_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
12701 qv_r = qv_r + qr_prim_rsy_vf(j + 1, k, l, i)*qvs(i)
12702 end do
12703
12704 re_max = 0
12705 if (re_size(1) > 0) re_max = 1
12706 if (re_size(2) > 0) re_max = 2
12707
12708 if (viscous) then
12709
12710# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12711#if defined(MFC_OpenACC)
12712# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12713!$acc loop seq
12714# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12715#elif defined(MFC_OpenMP)
12716# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12717
12718# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12719#endif
12720 do i = 1, re_max
12721 re_l(i) = 0._wp
12722 re_r(i) = 0._wp
12723
12724
12725# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12726#if defined(MFC_OpenACC)
12727# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12728!$acc loop seq
12729# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12730#elif defined(MFC_OpenMP)
12731# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12732
12733# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12734#endif
12735 do q = 1, re_size(i)
12736 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
12737 + re_l(i)
12738 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
12739 + re_r(i)
12740 end do
12741
12742 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
12743 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
12744 end do
12745 end if
12746
12747 if (chemistry) then
12748 c_sum_yi_phi = 0.0_wp
12749
12750# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12751#if defined(MFC_OpenACC)
12752# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12753!$acc loop seq
12754# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12755#elif defined(MFC_OpenMP)
12756# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12757
12758# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12759#endif
12760 do i = chemxb, chemxe
12761 ys_l(i - chemxb + 1) = ql_prim_rsy_vf(j, k, l, i)
12762 ys_r(i - chemxb + 1) = qr_prim_rsy_vf(j + 1, k, l, i)
12763 end do
12764
12765 call get_mixture_molecular_weight(ys_l, mw_l)
12766 call get_mixture_molecular_weight(ys_r, mw_r)
12767
12768# 3278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12769 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
12770 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
12771# 3281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12772
12773 r_gas_l = gas_constant/mw_l
12774 r_gas_r = gas_constant/mw_r
12775
12776 t_l = pres_l/rho_l/r_gas_l
12777 t_r = pres_r/rho_r/r_gas_r
12778
12779 call get_species_specific_heats_r(t_l, cp_il)
12780 call get_species_specific_heats_r(t_r, cp_ir)
12781
12782 if (chem_params%gamma_method == 1) then
12783 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
12784 gamma_il = cp_il/(cp_il - 1.0_wp)
12785 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
12786
12787 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
12788 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
12789 else if (chem_params%gamma_method == 2) then
12790 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
12791 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
12792 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
12793 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
12794 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
12795
12796 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
12797 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
12798 end if
12799
12800 call get_mixture_energy_mass(t_l, ys_l, e_l)
12801 call get_mixture_energy_mass(t_r, ys_r, e_r)
12802
12803 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
12804 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
12805 h_l = (e_l + pres_l)/rho_l
12806 h_r = (e_r + pres_r)/rho_r
12807 else
12808 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
12809 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
12810
12811 h_l = (e_l + pres_l)/rho_l
12812 h_r = (e_r + pres_r)/rho_r
12813 end if
12814
12815 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
12816 if (hypoelasticity) then
12817
12818# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12819#if defined(MFC_OpenACC)
12820# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12821!$acc loop seq
12822# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12823#elif defined(MFC_OpenMP)
12824# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12825
12826# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12827#endif
12828 do i = 1, strxe - strxb + 1
12829 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
12830 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
12831 end do
12832 g_l = 0._wp
12833 g_r = 0._wp
12834
12835# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12836#if defined(MFC_OpenACC)
12837# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12838!$acc loop seq
12839# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12840#elif defined(MFC_OpenMP)
12841# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12842
12843# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12844#endif
12845 do i = 1, num_fluids
12846 g_l = g_l + alpha_l(i)*gs_rs(i)
12847 g_r = g_r + alpha_r(i)*gs_rs(i)
12848 end do
12849
12850# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12851#if defined(MFC_OpenACC)
12852# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12853!$acc loop seq
12854# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12855#elif defined(MFC_OpenMP)
12856# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12857
12858# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12859#endif
12860 do i = 1, strxe - strxb + 1
12861 ! Elastic contribution to energy if G large enough
12862 if ((g_l > verysmall) .and. (g_r > verysmall)) then
12863 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
12864 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
12865 ! Additional terms in 2D and 3D
12866 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
12867 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
12868 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
12869 end if
12870 end if
12871 end do
12872 end if
12873
12874 ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY
12875 if (hyperelasticity) then
12876
12877# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12878#if defined(MFC_OpenACC)
12879# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12880!$acc loop seq
12881# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12882#elif defined(MFC_OpenMP)
12883# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12884
12885# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12886#endif
12887 do i = 1, num_dims
12888 xi_field_l(i) = ql_prim_rsy_vf(j, k, l, xibeg - 1 + i)
12889 xi_field_r(i) = qr_prim_rsy_vf(j + 1, k, l, xibeg - 1 + i)
12890 end do
12891 g_l = 0._wp
12892 g_r = 0._wp
12893
12894# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12895#if defined(MFC_OpenACC)
12896# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12897!$acc loop seq
12898# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12899#elif defined(MFC_OpenMP)
12900# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12901
12902# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12903#endif
12904 do i = 1, num_fluids
12905 ! Mixture left and right shear modulus
12906 g_l = g_l + alpha_l(i)*gs_rs(i)
12907 g_r = g_r + alpha_r(i)*gs_rs(i)
12908 end do
12909 ! Elastic contribution to energy if G large enough
12910 if (g_l > verysmall .and. g_r > verysmall) then
12911 e_l = e_l + g_l*ql_prim_rsy_vf(j, k, l, xiend + 1)
12912 e_r = e_r + g_r*qr_prim_rsy_vf(j + 1, k, l, xiend + 1)
12913 end if
12914
12915# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12916#if defined(MFC_OpenACC)
12917# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12918!$acc loop seq
12919# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12920#elif defined(MFC_OpenMP)
12921# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12922
12923# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12924#endif
12925 do i = 1, b_size - 1
12926 tau_e_l(i) = ql_prim_rsy_vf(j, k, l, strxb - 1 + i)
12927 tau_e_r(i) = qr_prim_rsy_vf(j + 1, k, l, strxb - 1 + i)
12928 end do
12929 end if
12930
12931 h_l = (e_l + pres_l)/rho_l
12932 h_r = (e_r + pres_r)/rho_r
12933
12934
12935# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12936 if (avg_state == 1) then
12937# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12938
12939# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12940 rho_avg = sqrt(rho_l*rho_r)
12941# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12942
12943# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12944 vel_avg_rms = 0._wp
12945# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12946
12947# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12948
12949# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12950#if defined(MFC_OpenACC)
12951# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12952!$acc loop seq
12953# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12954#elif defined(MFC_OpenMP)
12955# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12956
12957# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12958#endif
12959# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12960 do i = 1, num_vels
12961# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12962 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
12963# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12964 (sqrt(rho_l) + sqrt(rho_r))**2._wp
12965# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12966 end do
12967# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12968
12969# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12970 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
12971# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12972 (sqrt(rho_l) + sqrt(rho_r))
12973# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12974
12975# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12976 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
12977# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12978 (sqrt(rho_l) + sqrt(rho_r))
12979# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12980
12981# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12982 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
12983# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12984 (sqrt(rho_l) + sqrt(rho_r))**2._wp
12985# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12986
12987# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12988 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
12989# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12990 (sqrt(rho_l) + sqrt(rho_r))
12991# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12992
12993# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12994 if (chemistry) then
12995# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12996 eps = 0.001_wp
12997# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
12998 call get_species_enthalpies_rt(t_l, h_il)
12999# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13000 call get_species_enthalpies_rt(t_r, h_ir)
13001# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13002 h_il = h_il*gas_constant/molecular_weights*t_l
13003# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13004 h_ir = h_ir*gas_constant/molecular_weights*t_r
13005# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13006 call get_species_specific_heats_r(t_l, cp_il)
13007# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13008 call get_species_specific_heats_r(t_r, cp_ir)
13009# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13010
13011# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13012 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
13013# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13014 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
13015# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13016 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
13017# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13018 if (abs(t_l - t_r) < eps) then
13019# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13020 ! Case when T_L and T_R are very close
13021# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13022 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
13023# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13024 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
13025# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13026 else
13027# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13028 ! Normal calculation when T_L and T_R are sufficiently different
13029# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13030 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
13031# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13032 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
13033# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13034 end if
13035# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13036 gamma_avg = cp_avg/cv_avg
13037# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13038
13039# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13040 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
13041# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13042 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
13043# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13044
13045# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13046 end if
13047# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13048
13049# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13050 end if
13051# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13052
13053# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13054 if (avg_state == 2) then
13055# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13056 rho_avg = 5.e-1_wp*(rho_l + rho_r)
13057# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13058 vel_avg_rms = 0._wp
13059# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13060
13061# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13062#if defined(MFC_OpenACC)
13063# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13064!$acc loop seq
13065# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13066#elif defined(MFC_OpenMP)
13067# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13068
13069# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13070#endif
13071# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13072 do i = 1, num_vels
13073# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13074 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
13075# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13076 end do
13077# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13078
13079# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13080 h_avg = 5.e-1_wp*(h_l + h_r)
13081# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13082 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
13083# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13084 qv_avg = 5.e-1_wp*(qv_l + qv_r)
13085# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13086
13087# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13088 end if
13089# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13090
13091
13092 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
13093 vel_l_rms, 0._wp, c_l, qv_l)
13094
13095 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
13096 vel_r_rms, 0._wp, c_r, qv_r)
13097
13098 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
13099 ! variables are placeholders to call the subroutine.
13100 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
13101 vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
13102
13103 if (viscous) then
13104 if (chemistry) then
13105 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
13106 end if
13107
13108# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13109#if defined(MFC_OpenACC)
13110# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13111!$acc loop seq
13112# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13113#elif defined(MFC_OpenMP)
13114# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13115
13116# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13117#endif
13118 do i = 1, 2
13119 re_avg_rsy_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
13120 end do
13121 end if
13122
13123 ! Low Mach correction
13124 if (low_mach == 2) then
13125
13126# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13127 if (riemann_solver == 1 .or. riemann_solver == 5) then
13128# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13129
13130# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13131 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
13132# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13133 pcorr = 0._wp
13134# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13135
13136# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13137 if (low_mach == 1) then
13138# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13139 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
13140# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13141 end if
13142# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13143
13144# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13145 else if (riemann_solver == 2) then
13146# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13147 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
13148# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13149 pcorr = 0._wp
13150# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13151
13152# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13153 if (low_mach == 1) then
13154# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13155 pcorr = rho_l*rho_r* &
13156# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13157 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
13158# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13159 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
13160# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13161 (zcoef - 1._wp)
13162# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13163 else if (low_mach == 2) then
13164# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13165 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))))
13166# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13167 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))))
13168# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13169 vel_l(dir_idx(1)) = vel_l_tmp
13170# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13171 vel_r(dir_idx(1)) = vel_r_tmp
13172# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13173 end if
13174# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13175 end if
13176# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13177
13178 end if
13179
13180 if (wave_speeds == 1) then
13181 if (elasticity) then
13182 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
13183 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l), vel_r(dir_idx(1)) - sqrt(c_r*c_r + &
13184 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r))
13185 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
13186 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r), vel_l(dir_idx(1)) + sqrt(c_l*c_l + &
13187 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l))
13188 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + &
13189 tau_e_l(dir_idx_tau(1)) + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - &
13190 rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - &
13191 rho_r*(s_r - vel_r(dir_idx(1))))
13192 else
13193 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
13194 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
13195 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
13196 (s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1)))) &
13197 /(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
13198
13199 end if
13200 elseif (wave_speeds == 2) then
13201 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
13202 (vel_l(dir_idx(1)) - &
13203 vel_r(dir_idx(1))))
13204
13205 pres_sr = pres_sl
13206
13207 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
13208 (pres_sl/pres_l - 1._wp)*pres_l/ &
13209 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
13210 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
13211 (pres_sr/pres_r - 1._wp)*pres_r/ &
13212 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
13213
13214 s_l = vel_l(dir_idx(1)) - c_l*ms_l
13215 s_r = vel_r(dir_idx(1)) + c_r*ms_r
13216
13217 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
13218 (pres_l - pres_r)/ &
13219 (rho_avg*c_avg))
13220 end if
13221
13222 ! follows Einfeldt et al.
13223 ! s_M/P = min/max(0.,s_L/R)
13224 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
13225
13226 ! goes with q_star_L/R = xi_L/R * (variable)
13227 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
13228 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
13229 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
13230
13231 ! goes with numerical velocity in x/y/z directions
13232 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
13233 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
13234 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
13235
13236 ! Low Mach correction
13237 if (low_mach == 1) then
13238
13239# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13240 if (riemann_solver == 1 .or. riemann_solver == 5) then
13241# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13242
13243# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13244 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
13245# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13246 pcorr = 0._wp
13247# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13248
13249# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13250 if (low_mach == 1) then
13251# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13252 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
13253# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13254 end if
13255# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13256
13257# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13258 else if (riemann_solver == 2) then
13259# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13260 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
13261# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13262 pcorr = 0._wp
13263# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13264
13265# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13266 if (low_mach == 1) then
13267# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13268 pcorr = rho_l*rho_r* &
13269# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13270 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
13271# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13272 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
13273# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13274 (zcoef - 1._wp)
13275# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13276 else if (low_mach == 2) then
13277# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13278 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))))
13279# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13280 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))))
13281# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13282 vel_l(dir_idx(1)) = vel_l_tmp
13283# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13284 vel_r(dir_idx(1)) = vel_r_tmp
13285# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13286 end if
13287# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13288 end if
13289# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13290
13291 else
13292 pcorr = 0._wp
13293 end if
13294
13295 ! COMPUTING THE HLLC FLUXES
13296 ! MASS FLUX.
13297
13298# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13299#if defined(MFC_OpenACC)
13300# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13301!$acc loop seq
13302# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13303#elif defined(MFC_OpenMP)
13304# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13305
13306# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13307#endif
13308 do i = 1, contxe
13309 flux_rsy_vf(j, k, l, i) = &
13310 xi_m*ql_prim_rsy_vf(j, k, l, i) &
13311 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
13312 + xi_p*qr_prim_rsy_vf(j + 1, k, l, i) &
13313 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13314 end do
13315
13316 ! MOMENTUM FLUX.
13317 ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
13318
13319# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13320#if defined(MFC_OpenACC)
13321# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13322!$acc loop seq
13323# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13324#elif defined(MFC_OpenMP)
13325# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13326
13327# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13328#endif
13329 do i = 1, num_dims
13330 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
13331 xi_m*(rho_l*(vel_l(dir_idx(1))* &
13332 vel_l(dir_idx(i)) + &
13333 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
13334 (1._wp - dir_flg(dir_idx(i)))* &
13335 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
13336 dir_flg(dir_idx(i))*(pres_l)) &
13337 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
13338 vel_r(dir_idx(i)) + &
13339 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
13340 (1._wp - dir_flg(dir_idx(i)))* &
13341 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
13342 dir_flg(dir_idx(i))*(pres_r)) &
13343 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
13344 end do
13345
13346 ! ENERGY FLUX.
13347 ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
13348 flux_rsy_vf(j, k, l, e_idx) = &
13349 xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + &
13350 s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
13351 (rho_l*s_s + pres_l/ &
13352 (s_l - vel_l(dir_idx(1))))) - e_l)) &
13353 + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + &
13354 s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
13355 (rho_r*s_s + pres_r/ &
13356 (s_r - vel_r(dir_idx(1))))) - e_r)) &
13357 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
13358
13359 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
13360 if (elasticity) then
13361 flux_ene_e = 0._wp
13362
13363# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13364#if defined(MFC_OpenACC)
13365# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13366!$acc loop seq
13367# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13368#elif defined(MFC_OpenMP)
13369# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13370
13371# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13372#endif
13373 do i = 1, num_dims
13374 ! MOMENTUM ELASTIC FLUX.
13375 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) = &
13376 flux_rsy_vf(j, k, l, contxe + dir_idx(i)) &
13377 - xi_m*tau_e_l(dir_idx_tau(i)) - xi_p*tau_e_r(dir_idx_tau(i))
13378 ! ENERGY ELASTIC FLUX.
13379 flux_ene_e = flux_ene_e - &
13380 xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) + &
13381 s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i))/(s_l - vel_l(i)))))) - &
13382 xi_p*(vel_r(dir_idx(i))*tau_e_r(dir_idx_tau(i)) + &
13383 s_p*(xi_r*((s_s - vel_r(i))*(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
13384 end do
13385 flux_rsy_vf(j, k, l, e_idx) = flux_rsy_vf(j, k, l, e_idx) + flux_ene_e
13386 end if
13387
13388 ! HYPOELASTIC STRESS EVOLUTION FLUX.
13389 if (hypoelasticity) then
13390
13391# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13392#if defined(MFC_OpenACC)
13393# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13394!$acc loop seq
13395# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13396#elif defined(MFC_OpenMP)
13397# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13398
13399# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13400#endif
13401 do i = 1, strxe - strxb + 1
13402 flux_rsy_vf(j, k, l, strxb - 1 + i) = &
13403 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + &
13404 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
13405 end do
13406 end if
13407
13408 ! VOLUME FRACTION FLUX.
13409
13410# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13411#if defined(MFC_OpenACC)
13412# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13413!$acc loop seq
13414# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13415#elif defined(MFC_OpenMP)
13416# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13417
13418# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13419#endif
13420 do i = advxb, advxe
13421 flux_rsy_vf(j, k, l, i) = &
13422 xi_m*ql_prim_rsy_vf(j, k, l, i) &
13423 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
13424 + xi_p*qr_prim_rsy_vf(j + 1, k, l, i) &
13425 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13426 end do
13427
13428 ! VOLUME FRACTION SOURCE FLUX.
13429
13430# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13431#if defined(MFC_OpenACC)
13432# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13433!$acc loop seq
13434# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13435#elif defined(MFC_OpenMP)
13436# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13437
13438# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13439#endif
13440 do i = 1, num_dims
13441 vel_src_rsy_vf(j, k, l, dir_idx(i)) = &
13442 xi_m*(vel_l(dir_idx(i)) + &
13443 dir_flg(dir_idx(i))* &
13444 s_m*(xi_l - 1._wp)) &
13445 + xi_p*(vel_r(dir_idx(i)) + &
13446 dir_flg(dir_idx(i))* &
13447 s_p*(xi_r - 1._wp))
13448 end do
13449
13450 ! COLOR FUNCTION FLUX
13451 if (surface_tension) then
13452 flux_rsy_vf(j, k, l, c_idx) = &
13453 xi_m*ql_prim_rsy_vf(j, k, l, c_idx) &
13454 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
13455 + xi_p*qr_prim_rsy_vf(j + 1, k, l, c_idx) &
13456 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13457 end if
13458
13459 ! REFERENCE MAP FLUX.
13460 if (hyperelasticity) then
13461
13462# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13463#if defined(MFC_OpenACC)
13464# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13465!$acc loop seq
13466# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13467#elif defined(MFC_OpenMP)
13468# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13469
13470# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13471#endif
13472 do i = 1, num_dims
13473 flux_rsy_vf(j, k, l, xibeg - 1 + i) = &
13474 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
13475 - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + &
13476 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
13477 - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
13478 end do
13479 end if
13480
13481 flux_src_rsy_vf(j, k, l, advxb) = vel_src_rsy_vf(j, k, l, dir_idx(1))
13482
13483 if (chemistry) then
13484
13485# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13486#if defined(MFC_OpenACC)
13487# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13488!$acc loop seq
13489# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13490#elif defined(MFC_OpenMP)
13491# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13492
13493# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13494#endif
13495 do i = chemxb, chemxe
13496 y_l = ql_prim_rsy_vf(j, k, l, i)
13497 y_r = qr_prim_rsy_vf(j + 1, k, l, i)
13498
13499 flux_rsy_vf(j, k, l, i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
13500 + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
13501 flux_src_rsy_vf(j, k, l, i) = 0.0_wp
13502 end do
13503 end if
13504
13505 ! Geometrical source flux for cylindrical coordinates
13506# 3606 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13507 if (cyl_coord) then
13508 !Substituting the advective flux into the inviscid geometrical source flux
13509
13510# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13511#if defined(MFC_OpenACC)
13512# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13513!$acc loop seq
13514# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13515#elif defined(MFC_OpenMP)
13516# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13517
13518# 3608 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13519#endif
13520 do i = 1, e_idx
13521 flux_gsrc_rsy_vf(j, k, l, i) = flux_rsy_vf(j, k, l, i)
13522 end do
13523 ! Recalculating the radial momentum geometric source flux
13524 flux_gsrc_rsy_vf(j, k, l, contxe + dir_idx(1)) = &
13525 xi_m*(rho_l*(vel_l(dir_idx(1))* &
13526 vel_l(dir_idx(1)) + &
13527 s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + &
13528 (1._wp - dir_flg(dir_idx(1)))* &
13529 vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
13530 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
13531 vel_r(dir_idx(1)) + &
13532 s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + &
13533 (1._wp - dir_flg(dir_idx(1)))* &
13534 vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
13535 ! Geometrical source of the void fraction(s) is zero
13536
13537# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13538#if defined(MFC_OpenACC)
13539# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13540!$acc loop seq
13541# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13542#elif defined(MFC_OpenMP)
13543# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13544
13545# 3625 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13546#endif
13547 do i = advxb, advxe
13548 flux_gsrc_rsy_vf(j, k, l, i) = 0._wp
13549 end do
13550 end if
13551# 3631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13552# 3653 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13553
13554 end do
13555 end do
13556 end do
13557
13558# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13559
13560# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13561#if defined(MFC_OpenACC)
13562# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13563!$acc end parallel loop
13564# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13565#elif defined(MFC_OpenMP)
13566# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13567
13568# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13569
13570# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13571!$omp end target teams loop
13572# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13573#endif
13574# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13575
13576 end if
13577 end if
13578# 2084 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13579
13580 if (norm_dir == 3) then
13581
13582 ! 6-EQUATION MODEL WITH HLLC
13583 if (model_eqns == 3) then
13584 !ME3
13585
13586# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13587
13588# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13589#if defined(MFC_OpenACC)
13590# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13591!$acc parallel loop collapse(3) gang vector default(present) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
13592# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13593#elif defined(MFC_OpenMP)
13594# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13595
13596# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13597
13598# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13599
13600# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13601!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, j, k, l, q, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, tau_e_L, tau_e_R, flux_ene_e, xi_field_L, xi_field_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
13602# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13603#endif
13604# 2090 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13605
13606 do l = is3%beg, is3%end
13607 do k = is2%beg, is2%end
13608 do j = is1%beg, is1%end
13609
13610 vel_l_rms = 0._wp; vel_r_rms = 0._wp
13611 rho_l = 0._wp; rho_r = 0._wp
13612 gamma_l = 0._wp; gamma_r = 0._wp
13613 pi_inf_l = 0._wp; pi_inf_r = 0._wp
13614 qv_l = 0._wp; qv_r = 0._wp
13615 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
13616
13617
13618# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13619#if defined(MFC_OpenACC)
13620# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13621!$acc loop seq
13622# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13623#elif defined(MFC_OpenMP)
13624# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13625
13626# 2102 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13627#endif
13628 do i = 1, num_dims
13629 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
13630 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
13631 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
13632 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
13633 end do
13634
13635 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
13636 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
13637
13638 rho_l = 0._wp
13639 gamma_l = 0._wp
13640 pi_inf_l = 0._wp
13641 qv_l = 0._wp
13642
13643 rho_r = 0._wp
13644 gamma_r = 0._wp
13645 pi_inf_r = 0._wp
13646 qv_r = 0._wp
13647
13648 alpha_l_sum = 0._wp
13649 alpha_r_sum = 0._wp
13650
13651 if (mpp_lim) then
13652
13653# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13654#if defined(MFC_OpenACC)
13655# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13656!$acc loop seq
13657# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13658#elif defined(MFC_OpenMP)
13659# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13660
13661# 2127 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13662#endif
13663 do i = 1, num_fluids
13664 ql_prim_rsz_vf(j, k, l, i) = max(0._wp, ql_prim_rsz_vf(j, k, l, i))
13665 ql_prim_rsz_vf(j, k, l, e_idx + i) = min(max(0._wp, ql_prim_rsz_vf(j, k, l, e_idx + i)), 1._wp)
13666 alpha_l_sum = alpha_l_sum + ql_prim_rsz_vf(j, k, l, e_idx + i)
13667 end do
13668
13669
13670# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13671#if defined(MFC_OpenACC)
13672# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13673!$acc loop seq
13674# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13675#elif defined(MFC_OpenMP)
13676# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13677
13678# 2134 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13679#endif
13680 do i = 1, num_fluids
13681 qr_prim_rsz_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsz_vf(j + 1, k, l, i))
13682 qr_prim_rsz_vf(j + 1, k, l, e_idx + i) = min(max(0._wp, qr_prim_rsz_vf(j + 1, k, l, e_idx + i)), 1._wp)
13683 alpha_r_sum = alpha_r_sum + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
13684 end do
13685
13686
13687# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13688#if defined(MFC_OpenACC)
13689# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13690!$acc loop seq
13691# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13692#elif defined(MFC_OpenMP)
13693# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13694
13695# 2141 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13696#endif
13697 do i = 1, num_fluids
13698 ql_prim_rsz_vf(j, k, l, e_idx + i) = ql_prim_rsz_vf(j, k, l, e_idx + i)/max(alpha_l_sum, sgm_eps)
13699 qr_prim_rsz_vf(j + 1, k, l, e_idx + i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)/max(alpha_r_sum, sgm_eps)
13700 end do
13701 end if
13702
13703
13704# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13705#if defined(MFC_OpenACC)
13706# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13707!$acc loop seq
13708# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13709#elif defined(MFC_OpenMP)
13710# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13711
13712# 2148 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13713#endif
13714 do i = 1, num_fluids
13715 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
13716 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*gammas(i)
13717 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*pi_infs(i)
13718 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
13719
13720 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
13721 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*gammas(i)
13722 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
13723 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
13724
13725 alpha_l(i) = ql_prim_rsz_vf(j, k, l, advxb + i - 1)
13726 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, advxb + i - 1)
13727 end do
13728
13729 if (viscous) then
13730
13731# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13732#if defined(MFC_OpenACC)
13733# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13734!$acc loop seq
13735# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13736#elif defined(MFC_OpenMP)
13737# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13738
13739# 2165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13740#endif
13741 do i = 1, 2
13742 re_l(i) = dflt_real
13743 re_r(i) = dflt_real
13744 if (re_size(i) > 0) re_l(i) = 0._wp
13745 if (re_size(i) > 0) re_r(i) = 0._wp
13746
13747# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13748#if defined(MFC_OpenACC)
13749# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13750!$acc loop seq
13751# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13752#elif defined(MFC_OpenMP)
13753# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13754
13755# 2171 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13756#endif
13757 do q = 1, re_size(i)
13758 re_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + re_idx(i, q))/res_gs(i, q) &
13759 + re_l(i)
13760 re_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + re_idx(i, q))/res_gs(i, q) &
13761 + re_r(i)
13762 end do
13763 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
13764 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
13765 end do
13766 end if
13767
13768 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
13769 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
13770
13771 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
13772 if (hypoelasticity) then
13773
13774# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13775#if defined(MFC_OpenACC)
13776# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13777!$acc loop seq
13778# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13779#elif defined(MFC_OpenMP)
13780# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13781
13782# 2188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13783#endif
13784 do i = 1, strxe - strxb + 1
13785 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
13786 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
13787 end do
13788 g_l = 0._wp; g_r = 0._wp
13789
13790# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13791#if defined(MFC_OpenACC)
13792# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13793!$acc loop seq
13794# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13795#elif defined(MFC_OpenMP)
13796# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13797
13798# 2194 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13799#endif
13800 do i = 1, num_fluids
13801 g_l = g_l + alpha_l(i)*gs_rs(i)
13802 g_r = g_r + alpha_r(i)*gs_rs(i)
13803 end do
13804
13805# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13806#if defined(MFC_OpenACC)
13807# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13808!$acc loop seq
13809# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13810#elif defined(MFC_OpenMP)
13811# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13812
13813# 2199 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13814#endif
13815 do i = 1, strxe - strxb + 1
13816 ! Elastic contribution to energy if G large enough
13817 if ((g_l > verysmall) .and. (g_r > verysmall)) then
13818 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
13819 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
13820 ! Additional terms in 2D and 3D
13821 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
13822 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
13823 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
13824 end if
13825 end if
13826 end do
13827 end if
13828
13829 ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY
13830 if (hyperelasticity) then
13831
13832# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13833#if defined(MFC_OpenACC)
13834# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13835!$acc loop seq
13836# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13837#elif defined(MFC_OpenMP)
13838# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13839
13840# 2216 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13841#endif
13842 do i = 1, num_dims
13843 xi_field_l(i) = ql_prim_rsz_vf(j, k, l, xibeg - 1 + i)
13844 xi_field_r(i) = qr_prim_rsz_vf(j + 1, k, l, xibeg - 1 + i)
13845 end do
13846 g_l = 0._wp; g_r = 0._wp;
13847
13848# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13849#if defined(MFC_OpenACC)
13850# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13851!$acc loop seq
13852# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13853#elif defined(MFC_OpenMP)
13854# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13855
13856# 2222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13857#endif
13858 do i = 1, num_fluids
13859 ! Mixture left and right shear modulus
13860 g_l = g_l + alpha_l(i)*gs_rs(i)
13861 g_r = g_r + alpha_r(i)*gs_rs(i)
13862 end do
13863 ! Elastic contribution to energy if G large enough
13864 if (g_l > verysmall .and. g_r > verysmall) then
13865 e_l = e_l + g_l*ql_prim_rsz_vf(j, k, l, xiend + 1)
13866 e_r = e_r + g_r*qr_prim_rsz_vf(j + 1, k, l, xiend + 1)
13867 end if
13868
13869# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13870#if defined(MFC_OpenACC)
13871# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13872!$acc loop seq
13873# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13874#elif defined(MFC_OpenMP)
13875# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13876
13877# 2233 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13878#endif
13879 do i = 1, b_size - 1
13880 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
13881 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
13882 end do
13883 end if
13884
13885 h_l = (e_l + pres_l)/rho_l
13886 h_r = (e_r + pres_r)/rho_r
13887
13888
13889# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13890 if (avg_state == 1) then
13891# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13892
13893# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13894 rho_avg = sqrt(rho_l*rho_r)
13895# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13896
13897# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13898 vel_avg_rms = 0._wp
13899# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13900
13901# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13902
13903# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13904#if defined(MFC_OpenACC)
13905# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13906!$acc loop seq
13907# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13908#elif defined(MFC_OpenMP)
13909# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13910
13911# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13912#endif
13913# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13914 do i = 1, num_vels
13915# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13916 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
13917# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13918 (sqrt(rho_l) + sqrt(rho_r))**2._wp
13919# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13920 end do
13921# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13922
13923# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13924 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
13925# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13926 (sqrt(rho_l) + sqrt(rho_r))
13927# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13928
13929# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13930 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
13931# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13932 (sqrt(rho_l) + sqrt(rho_r))
13933# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13934
13935# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13936 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
13937# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13938 (sqrt(rho_l) + sqrt(rho_r))**2._wp
13939# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13940
13941# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13942 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
13943# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13944 (sqrt(rho_l) + sqrt(rho_r))
13945# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13946
13947# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13948 if (chemistry) then
13949# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13950 eps = 0.001_wp
13951# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13952 call get_species_enthalpies_rt(t_l, h_il)
13953# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13954 call get_species_enthalpies_rt(t_r, h_ir)
13955# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13956 h_il = h_il*gas_constant/molecular_weights*t_l
13957# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13958 h_ir = h_ir*gas_constant/molecular_weights*t_r
13959# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13960 call get_species_specific_heats_r(t_l, cp_il)
13961# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13962 call get_species_specific_heats_r(t_r, cp_ir)
13963# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13964
13965# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13966 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
13967# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13968 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
13969# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13970 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
13971# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13972 if (abs(t_l - t_r) < eps) then
13973# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13974 ! Case when T_L and T_R are very close
13975# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13976 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
13977# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13978 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
13979# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13980 else
13981# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13982 ! Normal calculation when T_L and T_R are sufficiently different
13983# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13984 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
13985# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13986 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
13987# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13988 end if
13989# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13990 gamma_avg = cp_avg/cv_avg
13991# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13992
13993# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13994 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
13995# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13996 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
13997# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
13998
13999# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14000 end if
14001# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14002
14003# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14004 end if
14005# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14006
14007# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14008 if (avg_state == 2) then
14009# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14010 rho_avg = 5.e-1_wp*(rho_l + rho_r)
14011# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14012 vel_avg_rms = 0._wp
14013# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14014
14015# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14016#if defined(MFC_OpenACC)
14017# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14018!$acc loop seq
14019# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14020#elif defined(MFC_OpenMP)
14021# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14022
14023# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14024#endif
14025# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14026 do i = 1, num_vels
14027# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14028 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
14029# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14030 end do
14031# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14032
14033# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14034 h_avg = 5.e-1_wp*(h_l + h_r)
14035# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14036 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
14037# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14038 qv_avg = 5.e-1_wp*(qv_l + qv_r)
14039# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14040
14041# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14042 end if
14043# 2243 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14044
14045
14046 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
14047 vel_l_rms, 0._wp, c_l, qv_l)
14048
14049 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
14050 vel_r_rms, 0._wp, c_r, qv_r)
14051
14052 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
14053 ! variables are placeholders to call the subroutine.
14054 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
14055 vel_avg_rms, 0._wp, c_avg, qv_avg)
14056
14057 if (viscous) then
14058
14059# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14060#if defined(MFC_OpenACC)
14061# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14062!$acc loop seq
14063# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14064#elif defined(MFC_OpenMP)
14065# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14066
14067# 2257 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14068#endif
14069 do i = 1, 2
14070 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
14071 end do
14072 end if
14073
14074 ! Low Mach correction
14075 if (low_mach == 2) then
14076
14077# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14078 if (riemann_solver == 1 .or. riemann_solver == 5) then
14079# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14080
14081# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14082 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14083# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14084 pcorr = 0._wp
14085# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14086
14087# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14088 if (low_mach == 1) then
14089# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14090 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14091# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14092 end if
14093# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14094
14095# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14096 else if (riemann_solver == 2) then
14097# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14098 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14099# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14100 pcorr = 0._wp
14101# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14102
14103# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14104 if (low_mach == 1) then
14105# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14106 pcorr = rho_l*rho_r* &
14107# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14108 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
14109# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14110 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
14111# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14112 (zcoef - 1._wp)
14113# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14114 else if (low_mach == 2) then
14115# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14116 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))))
14117# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14118 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))))
14119# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14120 vel_l(dir_idx(1)) = vel_l_tmp
14121# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14122 vel_r(dir_idx(1)) = vel_r_tmp
14123# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14124 end if
14125# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14126 end if
14127# 2265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14128
14129 end if
14130
14131 ! COMPUTING THE DIRECT WAVE SPEEDS
14132 if (wave_speeds == 1) then
14133 if (elasticity) then
14134 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
14135 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l), vel_r(dir_idx(1)) - sqrt(c_r*c_r + &
14136 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r))
14137 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
14138 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r), vel_l(dir_idx(1)) + sqrt(c_l*c_l + &
14139 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l))
14140 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + &
14141 tau_e_l(dir_idx_tau(1)) + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - &
14142 rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - &
14143 rho_r*(s_r - vel_r(dir_idx(1))))
14144 else
14145 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
14146 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
14147 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
14148 (s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1)))) &
14149 /(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
14150
14151 end if
14152 elseif (wave_speeds == 2) then
14153 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
14154 (vel_l(dir_idx(1)) - &
14155 vel_r(dir_idx(1))))
14156
14157 pres_sr = pres_sl
14158
14159 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
14160 (pres_sl/pres_l - 1._wp)*pres_l/ &
14161 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
14162 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
14163 (pres_sr/pres_r - 1._wp)*pres_r/ &
14164 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
14165
14166 s_l = vel_l(dir_idx(1)) - c_l*ms_l
14167 s_r = vel_r(dir_idx(1)) + c_r*ms_r
14168
14169 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
14170 (pres_l - pres_r)/ &
14171 (rho_avg*c_avg))
14172 end if
14173
14174 ! follows Einfeldt et al.
14175 ! s_M/P = min/max(0.,s_L/R)
14176 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
14177
14178 ! goes with q_star_L/R = xi_L/R * (variable)
14179 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
14180 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
14181 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
14182
14183 ! goes with numerical star velocity in x/y/z directions
14184 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
14185 xi_m = (5.e-1_wp + sign(0.5_wp, s_s))
14186 xi_p = (5.e-1_wp - sign(0.5_wp, s_s))
14187
14188 ! goes with the numerical velocity in x/y/z directions
14189 ! xi_P/M (pressure) = min/max(0. sgn(1,sL/sR))
14190 xi_mp = -min(0._wp, sign(1._wp, s_l))
14191 xi_pp = max(0._wp, sign(1._wp, s_r))
14192
14193 e_star = xi_m*(e_l + xi_mp*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
14194 (rho_l*s_s + pres_l/(s_l - vel_l(dir_idx(1))))) - e_l)) + &
14195 xi_p*(e_r + xi_pp*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
14196 (rho_r*s_s + pres_r/(s_r - vel_r(dir_idx(1))))) - e_r))
14197 p_star = xi_m*(pres_l + xi_mp*(rho_l*(s_l - vel_l(dir_idx(1)))*(s_s - vel_l(dir_idx(1))))) + &
14198 xi_p*(pres_r + xi_pp*(rho_r*(s_r - vel_r(dir_idx(1)))*(s_s - vel_r(dir_idx(1)))))
14199
14200 rho_star = xi_m*(rho_l*(xi_mp*xi_l + 1._wp - xi_mp)) + &
14201 xi_p*(rho_r*(xi_pp*xi_r + 1._wp - xi_pp))
14202
14203 vel_k_star = vel_l(dir_idx(1))*(1._wp - xi_mp) + xi_mp*vel_r(dir_idx(1)) + &
14204 xi_mp*xi_pp*(s_s - vel_r(dir_idx(1)))
14205
14206 ! Low Mach correction
14207 if (low_mach == 1) then
14208
14209# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14210 if (riemann_solver == 1 .or. riemann_solver == 5) then
14211# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14212
14213# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14214 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14215# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14216 pcorr = 0._wp
14217# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14218
14219# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14220 if (low_mach == 1) then
14221# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14222 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
14223# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14224 end if
14225# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14226
14227# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14228 else if (riemann_solver == 2) then
14229# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14230 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
14231# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14232 pcorr = 0._wp
14233# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14234
14235# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14236 if (low_mach == 1) then
14237# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14238 pcorr = rho_l*rho_r* &
14239# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14240 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
14241# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14242 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
14243# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14244 (zcoef - 1._wp)
14245# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14246 else if (low_mach == 2) then
14247# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14248 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))))
14249# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14250 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))))
14251# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14252 vel_l(dir_idx(1)) = vel_l_tmp
14253# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14254 vel_r(dir_idx(1)) = vel_r_tmp
14255# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14256 end if
14257# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14258 end if
14259# 2345 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14260
14261 else
14262 pcorr = 0._wp
14263 end if
14264
14265 ! COMPUTING FLUXES
14266 ! MASS FLUX.
14267
14268# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14269#if defined(MFC_OpenACC)
14270# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14271!$acc loop seq
14272# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14273#elif defined(MFC_OpenMP)
14274# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14275
14276# 2352 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14277#endif
14278 do i = 1, contxe
14279 flux_rsz_vf(j, k, l, i) = &
14280 xi_m*ql_prim_rsz_vf(j, k, l, i)*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) + &
14281 xi_p*qr_prim_rsz_vf(j + 1, k, l, i)*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14282 end do
14283
14284 ! MOMENTUM FLUX.
14285 ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
14286
14287# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14288#if defined(MFC_OpenACC)
14289# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14290!$acc loop seq
14291# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14292#elif defined(MFC_OpenMP)
14293# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14294
14295# 2361 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14296#endif
14297 do i = 1, num_dims
14298 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = rho_star*vel_k_star* &
14299 (dir_flg(dir_idx(i))*vel_k_star + (1._wp - dir_flg(dir_idx(i)))*(xi_m*vel_l(dir_idx(i)) + xi_p*vel_r(dir_idx(i)))) + dir_flg(dir_idx(i))*p_star &
14300 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
14301 end do
14302
14303 ! ENERGY FLUX.
14304 ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
14305 flux_rsz_vf(j, k, l, e_idx) = (e_star + p_star)*vel_k_star &
14306 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
14307
14308 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
14309 if (elasticity) then
14310 flux_ene_e = 0._wp;
14311
14312# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14313#if defined(MFC_OpenACC)
14314# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14315!$acc loop seq
14316# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14317#elif defined(MFC_OpenMP)
14318# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14319
14320# 2376 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14321#endif
14322 do i = 1, num_dims
14323 ! MOMENTUM ELASTIC FLUX.
14324 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
14325 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) &
14326 - xi_m*tau_e_l(dir_idx_tau(i)) - xi_p*tau_e_r(dir_idx_tau(i))
14327 ! ENERGY ELASTIC FLUX.
14328 flux_ene_e = flux_ene_e - &
14329 xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) + &
14330 s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i))/(s_l - vel_l(i)))))) - &
14331 xi_p*(vel_r(dir_idx(i))*tau_e_r(dir_idx_tau(i)) + &
14332 s_p*(xi_r*((s_s - vel_r(i))*(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
14333 end do
14334 flux_rsz_vf(j, k, l, e_idx) = flux_rsz_vf(j, k, l, e_idx) + flux_ene_e
14335 end if
14336
14337 ! VOLUME FRACTION FLUX.
14338
14339# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14340#if defined(MFC_OpenACC)
14341# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14342!$acc loop seq
14343# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14344#elif defined(MFC_OpenMP)
14345# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14346
14347# 2393 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14348#endif
14349 do i = advxb, advxe
14350 flux_rsz_vf(j, k, l, i) = &
14351 xi_m*ql_prim_rsz_vf(j, k, l, i)*s_s + &
14352 xi_p*qr_prim_rsz_vf(j + 1, k, l, i)*s_s
14353 end do
14354
14355 ! SOURCE TERM FOR VOLUME FRACTION ADVECTION FLUX.
14356
14357# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14358#if defined(MFC_OpenACC)
14359# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14360!$acc loop seq
14361# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14362#elif defined(MFC_OpenMP)
14363# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14364
14365# 2401 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14366#endif
14367 do i = 1, num_dims
14368 vel_src_rsz_vf(j, k, l, dir_idx(i)) = &
14369 xi_m*(vel_l(dir_idx(i)) + dir_flg(dir_idx(i))*(s_s*(xi_mp*(xi_l - 1) + 1) - vel_l(dir_idx(i)))) + &
14370 xi_p*(vel_r(dir_idx(i)) + dir_flg(dir_idx(i))*(s_s*(xi_pp*(xi_r - 1) + 1) - vel_r(dir_idx(i))))
14371 end do
14372
14373 ! INTERNAL ENERGIES ADVECTION FLUX.
14374 ! K-th pressure and velocity in preparation for the internal energy flux
14375
14376# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14377#if defined(MFC_OpenACC)
14378# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14379!$acc loop seq
14380# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14381#elif defined(MFC_OpenMP)
14382# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14383
14384# 2410 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14385#endif
14386 do i = 1, num_fluids
14387 p_k_star = xi_m*(xi_mp*((pres_l + pi_infs(i)/(1._wp + gammas(i)))* &
14388 xi_l**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_l) + pres_l) + &
14389 xi_p*(xi_pp*((pres_r + pi_infs(i)/(1._wp + gammas(i)))* &
14390 xi_r**(1._wp/gammas(i) + 1._wp) - pi_infs(i)/(1._wp + gammas(i)) - pres_r) + pres_r)
14391
14392 flux_rsz_vf(j, k, l, i + intxb - 1) = &
14393 ((xi_m*ql_prim_rsz_vf(j, k, l, i + advxb - 1) + xi_p*qr_prim_rsz_vf(j + 1, k, l, i + advxb - 1))* &
14394 (gammas(i)*p_k_star + pi_infs(i)) + &
14395 (xi_m*ql_prim_rsz_vf(j, k, l, i + contxb - 1) + xi_p*qr_prim_rsz_vf(j + 1, k, l, i + contxb - 1))* &
14396 qvs(i))*vel_k_star &
14397 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s*(xi_m*ql_prim_rsz_vf(j, k, l, i + advxb - 1) + xi_p*qr_prim_rsz_vf(j + 1, k, l, i + advxb - 1))
14398 end do
14399
14400 flux_src_rsz_vf(j, k, l, advxb) = vel_src_rsz_vf(j, k, l, dir_idx(1))
14401
14402 ! HYPOELASTIC STRESS EVOLUTION FLUX.
14403 if (hypoelasticity) then
14404
14405# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14406#if defined(MFC_OpenACC)
14407# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14408!$acc loop seq
14409# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14410#elif defined(MFC_OpenMP)
14411# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14412
14413# 2429 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14414#endif
14415 do i = 1, strxe - strxb + 1
14416 flux_rsz_vf(j, k, l, strxb - 1 + i) = &
14417 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + &
14418 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
14419 end do
14420 end if
14421
14422 ! REFERENCE MAP FLUX.
14423 if (hyperelasticity) then
14424
14425# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14426#if defined(MFC_OpenACC)
14427# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14428!$acc loop seq
14429# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14430#elif defined(MFC_OpenMP)
14431# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14432
14433# 2439 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14434#endif
14435 do i = 1, num_dims
14436 flux_rsz_vf(j, k, l, xibeg - 1 + i) = &
14437 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
14438 - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + &
14439 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
14440 - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
14441 end do
14442 end if
14443
14444 ! COLOR FUNCTION FLUX
14445 if (surface_tension) then
14446 flux_rsz_vf(j, k, l, c_idx) = &
14447 (xi_m*ql_prim_rsz_vf(j, k, l, c_idx) + &
14448 xi_p*qr_prim_rsz_vf(j + 1, k, l, c_idx))*s_s
14449 end if
14450
14451 ! Geometrical source flux for cylindrical coordinates
14452# 2478 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14453# 2479 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14454 if (grid_geometry == 3) then
14455
14456# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14457#if defined(MFC_OpenACC)
14458# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14459!$acc loop seq
14460# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14461#elif defined(MFC_OpenMP)
14462# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14463
14464# 2480 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14465#endif
14466 do i = 1, sys_size
14467 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
14468 end do
14469 flux_gsrc_rsz_vf(j, k, l, momxb - 1 + dir_idx(1)) = &
14470 flux_gsrc_rsz_vf(j, k, l, momxb - 1 + dir_idx(1)) - p_star
14471
14472 flux_gsrc_rsz_vf(j, k, l, momxe) = flux_rsz_vf(j, k, l, momxb + 1)
14473 end if
14474# 2490 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14475
14476 end do
14477 end do
14478 end do
14479
14480# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14481
14482# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14483#if defined(MFC_OpenACC)
14484# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14485!$acc end parallel loop
14486# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14487#elif defined(MFC_OpenMP)
14488# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14489
14490# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14491
14492# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14493!$omp end target teams loop
14494# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14495#endif
14496# 2494 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14497
14498
14499 elseif (model_eqns == 4) then
14500 !ME4
14501
14502# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14503
14504# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14505#if defined(MFC_OpenACC)
14506# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14507!$acc parallel loop collapse(3) gang vector default(present) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
14508# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14509#elif defined(MFC_OpenMP)
14510# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14511
14512# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14513
14514# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14515
14516# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14517!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, alpha_rho_L, alpha_rho_R, vel_L, vel_R, alpha_L, alpha_R, nbub_L, nbub_R, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, Cp_avg, Cv_avg, T_avg, eps, c_sum_Yi_Phi, T_L, T_R, Y_L, Y_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Gamm_L, Gamm_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, G_L, G_R, rho_avg, H_avg, c_avg, gamma_avg, ptilde_L, ptilde_R, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, rho_Star, E_Star, p_Star, p_K_Star, vel_K_star, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP)
14518# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14519#endif
14520# 2498 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14521
14522 do l = is3%beg, is3%end
14523 do k = is2%beg, is2%end
14524 do j = is1%beg, is1%end
14525
14526 vel_l_rms = 0._wp; vel_r_rms = 0._wp
14527 rho_l = 0._wp; rho_r = 0._wp
14528 gamma_l = 0._wp; gamma_r = 0._wp
14529 pi_inf_l = 0._wp; pi_inf_r = 0._wp
14530 qv_l = 0._wp; qv_r = 0._wp
14531
14532
14533# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14534#if defined(MFC_OpenACC)
14535# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14536!$acc loop seq
14537# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14538#elif defined(MFC_OpenMP)
14539# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14540
14541# 2509 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14542#endif
14543 do i = 1, contxe
14544 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
14545 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
14546 end do
14547
14548
14549# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14550#if defined(MFC_OpenACC)
14551# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14552!$acc loop seq
14553# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14554#elif defined(MFC_OpenMP)
14555# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14556
14557# 2515 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14558#endif
14559 do i = 1, num_dims
14560 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
14561 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
14562 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
14563 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
14564 end do
14565
14566
14567# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14568#if defined(MFC_OpenACC)
14569# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14570!$acc loop seq
14571# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14572#elif defined(MFC_OpenMP)
14573# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14574
14575# 2523 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14576#endif
14577 do i = 1, num_fluids
14578 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
14579 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
14580 end do
14581
14582# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14583#if defined(MFC_OpenACC)
14584# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14585!$acc loop seq
14586# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14587#elif defined(MFC_OpenMP)
14588# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14589
14590# 2528 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14591#endif
14592 do i = 1, num_fluids
14593 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
14594 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
14595 end do
14596
14597
14598# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14599#if defined(MFC_OpenACC)
14600# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14601!$acc loop seq
14602# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14603#elif defined(MFC_OpenMP)
14604# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14605
14606# 2534 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14607#endif
14608 do i = 1, num_fluids
14609 rho_l = rho_l + alpha_rho_l(i)
14610 gamma_l = gamma_l + alpha_l(i)*gammas(i)
14611 pi_inf_l = pi_inf_l + alpha_l(i)*pi_infs(i)
14612 qv_l = qv_l + alpha_rho_l(i)*qvs(i)
14613
14614 rho_r = rho_r + alpha_rho_r(i)
14615 gamma_r = gamma_r + alpha_r(i)*gammas(i)
14616 pi_inf_r = pi_inf_r + alpha_r(i)*pi_infs(i)
14617 qv_r = qv_r + alpha_rho_r(i)*qvs(i)
14618 end do
14619
14620 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
14621 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
14622
14623 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms + qv_l
14624 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms + qv_r
14625
14626 h_l = (e_l + pres_l)/rho_l
14627 h_r = (e_r + pres_r)/rho_r
14628
14629
14630# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14631 if (avg_state == 1) then
14632# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14633
14634# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14635 rho_avg = sqrt(rho_l*rho_r)
14636# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14637
14638# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14639 vel_avg_rms = 0._wp
14640# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14641
14642# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14643
14644# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14645#if defined(MFC_OpenACC)
14646# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14647!$acc loop seq
14648# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14649#elif defined(MFC_OpenMP)
14650# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14651
14652# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14653#endif
14654# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14655 do i = 1, num_vels
14656# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14657 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
14658# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14659 (sqrt(rho_l) + sqrt(rho_r))**2._wp
14660# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14661 end do
14662# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14663
14664# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14665 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
14666# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14667 (sqrt(rho_l) + sqrt(rho_r))
14668# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14669
14670# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14671 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
14672# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14673 (sqrt(rho_l) + sqrt(rho_r))
14674# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14675
14676# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14677 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
14678# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14679 (sqrt(rho_l) + sqrt(rho_r))**2._wp
14680# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14681
14682# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14683 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
14684# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14685 (sqrt(rho_l) + sqrt(rho_r))
14686# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14687
14688# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14689 if (chemistry) then
14690# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14691 eps = 0.001_wp
14692# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14693 call get_species_enthalpies_rt(t_l, h_il)
14694# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14695 call get_species_enthalpies_rt(t_r, h_ir)
14696# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14697 h_il = h_il*gas_constant/molecular_weights*t_l
14698# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14699 h_ir = h_ir*gas_constant/molecular_weights*t_r
14700# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14701 call get_species_specific_heats_r(t_l, cp_il)
14702# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14703 call get_species_specific_heats_r(t_r, cp_ir)
14704# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14705
14706# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14707 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
14708# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14709 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
14710# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14711 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
14712# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14713 if (abs(t_l - t_r) < eps) then
14714# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14715 ! Case when T_L and T_R are very close
14716# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14717 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
14718# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14719 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
14720# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14721 else
14722# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14723 ! Normal calculation when T_L and T_R are sufficiently different
14724# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14725 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
14726# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14727 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
14728# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14729 end if
14730# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14731 gamma_avg = cp_avg/cv_avg
14732# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14733
14734# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14735 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
14736# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14737 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
14738# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14739
14740# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14741 end if
14742# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14743
14744# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14745 end if
14746# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14747
14748# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14749 if (avg_state == 2) then
14750# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14751 rho_avg = 5.e-1_wp*(rho_l + rho_r)
14752# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14753 vel_avg_rms = 0._wp
14754# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14755
14756# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14757#if defined(MFC_OpenACC)
14758# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14759!$acc loop seq
14760# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14761#elif defined(MFC_OpenMP)
14762# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14763
14764# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14765#endif
14766# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14767 do i = 1, num_vels
14768# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14769 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
14770# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14771 end do
14772# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14773
14774# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14775 h_avg = 5.e-1_wp*(h_l + h_r)
14776# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14777 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
14778# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14779 qv_avg = 5.e-1_wp*(qv_l + qv_r)
14780# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14781
14782# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14783 end if
14784# 2556 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14785
14786
14787 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
14788 vel_l_rms, 0._wp, c_l, qv_l)
14789
14790 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
14791 vel_r_rms, 0._wp, c_r, qv_r)
14792
14793 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
14794 ! variables are placeholders to call the subroutine.
14795
14796 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
14797 vel_avg_rms, 0._wp, c_avg, qv_avg)
14798
14799 if (wave_speeds == 1) then
14800 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
14801 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
14802
14803 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
14804 (s_l - vel_l(dir_idx(1))) - &
14805 rho_r*vel_r(dir_idx(1))* &
14806 (s_r - vel_r(dir_idx(1)))) &
14807 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
14808 rho_r*(s_r - vel_r(dir_idx(1))))
14809 elseif (wave_speeds == 2) then
14810 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
14811 (vel_l(dir_idx(1)) - &
14812 vel_r(dir_idx(1))))
14813
14814 pres_sr = pres_sl
14815
14816 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
14817 (pres_sl/pres_l - 1._wp)*pres_l/ &
14818 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
14819 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
14820 (pres_sr/pres_r - 1._wp)*pres_r/ &
14821 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
14822
14823 s_l = vel_l(dir_idx(1)) - c_l*ms_l
14824 s_r = vel_r(dir_idx(1)) + c_r*ms_r
14825
14826 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
14827 (pres_l - pres_r)/ &
14828 (rho_avg*c_avg))
14829 end if
14830
14831 ! follows Einfeldt et al.
14832 ! s_M/P = min/max(0.,s_L/R)
14833 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
14834
14835 ! goes with q_star_L/R = xi_L/R * (variable)
14836 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
14837 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
14838 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
14839
14840 ! goes with numerical velocity in x/y/z directions
14841 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
14842 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
14843 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
14844
14845
14846# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14847#if defined(MFC_OpenACC)
14848# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14849!$acc loop seq
14850# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14851#elif defined(MFC_OpenMP)
14852# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14853
14854# 2616 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14855#endif
14856 do i = 1, contxe
14857 flux_rsz_vf(j, k, l, i) = &
14858 xi_m*alpha_rho_l(i) &
14859 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
14860 + xi_p*alpha_rho_r(i) &
14861 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14862 end do
14863
14864 ! Momentum flux.
14865 ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
14866
14867# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14868#if defined(MFC_OpenACC)
14869# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14870!$acc loop seq
14871# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14872#elif defined(MFC_OpenMP)
14873# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14874
14875# 2627 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14876#endif
14877 do i = 1, num_dims
14878 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
14879 xi_m*(rho_l*(vel_l(dir_idx(1))* &
14880 vel_l(dir_idx(i)) + &
14881 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
14882 (1._wp - dir_flg(dir_idx(i)))* &
14883 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
14884 dir_flg(dir_idx(i))*pres_l) &
14885 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
14886 vel_r(dir_idx(i)) + &
14887 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
14888 (1._wp - dir_flg(dir_idx(i)))* &
14889 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
14890 dir_flg(dir_idx(i))*pres_r)
14891 end do
14892
14893 if (bubbles_euler) then
14894 ! Put p_tilde in
14895
14896# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14897#if defined(MFC_OpenACC)
14898# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14899!$acc loop seq
14900# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14901#elif defined(MFC_OpenMP)
14902# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14903
14904# 2646 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14905#endif
14906 do i = 1, num_dims
14907 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
14908 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) + &
14909 xi_m*(dir_flg(dir_idx(i))*(-1._wp*ptilde_l)) &
14910 + xi_p*(dir_flg(dir_idx(i))*(-1._wp*ptilde_r))
14911 end do
14912 end if
14913
14914 flux_rsz_vf(j, k, l, e_idx) = 0._wp
14915
14916
14917# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14918#if defined(MFC_OpenACC)
14919# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14920!$acc loop seq
14921# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14922#elif defined(MFC_OpenMP)
14923# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14924
14925# 2657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14926#endif
14927 do i = alf_idx, alf_idx !only advect the void fraction
14928 flux_rsz_vf(j, k, l, i) = &
14929 xi_m*ql_prim_rsz_vf(j, k, l, i) &
14930 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
14931 + xi_p*qr_prim_rsz_vf(j + 1, k, l, i) &
14932 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14933 end do
14934
14935 ! Source for volume fraction advection equation
14936
14937# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14938#if defined(MFC_OpenACC)
14939# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14940!$acc loop seq
14941# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14942#elif defined(MFC_OpenMP)
14943# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14944
14945# 2667 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14946#endif
14947 do i = 1, num_dims
14948
14949 vel_src_rsz_vf(j, k, l, dir_idx(i)) = 0._wp
14950 !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
14951 end do
14952
14953 flux_src_rsz_vf(j, k, l, advxb) = vel_src_rsz_vf(j, k, l, dir_idx(1))
14954
14955 ! Add advection flux for bubble variables
14956 if (bubbles_euler) then
14957
14958# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14959#if defined(MFC_OpenACC)
14960# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14961!$acc loop seq
14962# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14963#elif defined(MFC_OpenMP)
14964# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14965
14966# 2678 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14967#endif
14968 do i = bubxb, bubxe
14969 flux_rsz_vf(j, k, l, i) = &
14970 xi_m*nbub_l*ql_prim_rsz_vf(j, k, l, i) &
14971 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
14972 + xi_p*nbub_r*qr_prim_rsz_vf(j + 1, k, l, i) &
14973 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
14974 end do
14975 end if
14976
14977 ! Geometrical source flux for cylindrical coordinates
14978
14979# 2716 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14980# 2717 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14981 if (grid_geometry == 3) then
14982
14983# 2718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14984#if defined(MFC_OpenACC)
14985# 2718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14986!$acc loop seq
14987# 2718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14988#elif defined(MFC_OpenMP)
14989# 2718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14990
14991# 2718 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
14992#endif
14993 do i = 1, sys_size
14994 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
14995 end do
14996 flux_gsrc_rsz_vf(j, k, l, momxb + 1) = &
14997 -xi_m*(rho_l*(vel_l(dir_idx(1))* &
14998 vel_l(dir_idx(1)) + &
14999 s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + &
15000 (1._wp - dir_flg(dir_idx(1)))* &
15001 vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
15002 - xi_p*(rho_r*(vel_r(dir_idx(1))* &
15003 vel_r(dir_idx(1)) + &
15004 s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + &
15005 (1._wp - dir_flg(dir_idx(1)))* &
15006 vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
15007 flux_gsrc_rsz_vf(j, k, l, momxe) = flux_rsz_vf(j, k, l, momxb + 1)
15008 end if
15009# 2736 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15010 end do
15011 end do
15012 end do
15013
15014# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15015
15016# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15017#if defined(MFC_OpenACC)
15018# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15019!$acc end parallel loop
15020# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15021#elif defined(MFC_OpenMP)
15022# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15023
15024# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15025
15026# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15027!$omp end target teams loop
15028# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15029#endif
15030# 2739 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15031
15032
15033 elseif (model_eqns == 2 .and. bubbles_euler) then
15034
15035# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15036
15037# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15038#if defined(MFC_OpenACC)
15039# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15040!$acc parallel loop collapse(3) gang vector default(present) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar)
15041# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15042#elif defined(MFC_OpenMP)
15043# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15044
15045# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15046
15047# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15048
15049# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15050!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(i, q, R0_L, R0_R, V0_L, V0_R, P0_L, P0_R, pbw_L, pbw_R, vel_L, vel_R, rho_avg, alpha_L, alpha_R, h_avg, gamma_avg, Re_L, Re_R, pcorr, zcoef, rho_L, rho_R, pres_L, pres_R, E_L, E_R, H_L, H_R, gamma_L, gamma_R, pi_inf_L, pi_inf_R, qv_L, qv_R, qv_avg, c_L, c_R, c_avg, vel_L_rms, vel_R_rms, vel_avg_rms, vel_L_tmp, vel_R_tmp, Ms_L, Ms_R, pres_SL, pres_SR, alpha_L_sum, alpha_R_sum, s_L, s_R, s_M, s_P, s_S, xi_M, xi_P, xi_L, xi_R, xi_MP, xi_PP, nbub_L, nbub_R, PbwR3Lbar, PbwR3Rbar, R3Lbar, R3Rbar, R3V2Lbar, R3V2Rbar)
15051# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15052#endif
15053# 2742 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15054
15055 do l = is3%beg, is3%end
15056 do k = is2%beg, is2%end
15057 do j = is1%beg, is1%end
15058
15059 vel_l_rms = 0._wp; vel_r_rms = 0._wp
15060 rho_l = 0._wp; rho_r = 0._wp
15061 gamma_l = 0._wp; gamma_r = 0._wp
15062 pi_inf_l = 0._wp; pi_inf_r = 0._wp
15063 qv_l = 0._wp; qv_r = 0._wp
15064
15065
15066# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15067#if defined(MFC_OpenACC)
15068# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15069!$acc loop seq
15070# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15071#elif defined(MFC_OpenMP)
15072# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15073
15074# 2753 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15075#endif
15076 do i = 1, num_fluids
15077 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
15078 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
15079 end do
15080
15081 vel_l_rms = 0._wp; vel_r_rms = 0._wp
15082
15083
15084# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15085#if defined(MFC_OpenACC)
15086# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15087!$acc loop seq
15088# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15089#elif defined(MFC_OpenMP)
15090# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15091
15092# 2761 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15093#endif
15094 do i = 1, num_dims
15095 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
15096 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
15097 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
15098 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
15099 end do
15100
15101 ! Retain this in the refactor
15102 if (mpp_lim .and. (num_fluids > 2)) then
15103
15104# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15105#if defined(MFC_OpenACC)
15106# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15107!$acc loop seq
15108# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15109#elif defined(MFC_OpenMP)
15110# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15111
15112# 2771 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15113#endif
15114 do i = 1, num_fluids
15115 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
15116 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*gammas(i)
15117 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*pi_infs(i)
15118 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
15119 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
15120 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*gammas(i)
15121 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
15122 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
15123 end do
15124 else if (num_fluids > 2) then
15125
15126# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15127#if defined(MFC_OpenACC)
15128# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15129!$acc loop seq
15130# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15131#elif defined(MFC_OpenMP)
15132# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15133
15134# 2783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15135#endif
15136 do i = 1, num_fluids - 1
15137 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
15138 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*gammas(i)
15139 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*pi_infs(i)
15140 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
15141 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
15142 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*gammas(i)
15143 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
15144 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
15145 end do
15146 else
15147 rho_l = ql_prim_rsz_vf(j, k, l, 1)
15148 gamma_l = gammas(1)
15149 pi_inf_l = pi_infs(1)
15150 qv_l = qvs(1)
15151 rho_r = qr_prim_rsz_vf(j + 1, k, l, 1)
15152 gamma_r = gammas(1)
15153 pi_inf_r = pi_infs(1)
15154 qv_r = qvs(1)
15155 end if
15156
15157 if (viscous) then
15158 if (num_fluids == 1) then ! Need to consider case with num_fluids >= 2
15159
15160# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15161#if defined(MFC_OpenACC)
15162# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15163!$acc loop seq
15164# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15165#elif defined(MFC_OpenMP)
15166# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15167
15168# 2807 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15169#endif
15170 do i = 1, 2
15171 re_l(i) = dflt_real
15172 re_r(i) = dflt_real
15173
15174 if (re_size(i) > 0) re_l(i) = 0._wp
15175 if (re_size(i) > 0) re_r(i) = 0._wp
15176
15177
15178# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15179#if defined(MFC_OpenACC)
15180# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15181!$acc loop seq
15182# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15183#elif defined(MFC_OpenMP)
15184# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15185
15186# 2815 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15187#endif
15188 do q = 1, re_size(i)
15189 re_l(i) = (1._wp - ql_prim_rsz_vf(j, k, l, e_idx + re_idx(i, q)))/res_gs(i, q) &
15190 + re_l(i)
15191 re_r(i) = (1._wp - qr_prim_rsz_vf(j + 1, k, l, e_idx + re_idx(i, q)))/res_gs(i, q) &
15192 + re_r(i)
15193 end do
15194
15195 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
15196 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
15197
15198 end do
15199 end if
15200 end if
15201
15202 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
15203 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
15204
15205 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1_wp*rho_l*vel_l_rms
15206 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1_wp*rho_r*vel_r_rms
15207
15208 h_l = (e_l + pres_l)/rho_l
15209 h_r = (e_r + pres_r)/rho_r
15210
15211 if (avg_state == 2) then
15212
15213# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15214#if defined(MFC_OpenACC)
15215# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15216!$acc loop seq
15217# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15218#elif defined(MFC_OpenMP)
15219# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15220
15221# 2840 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15222#endif
15223 do i = 1, nb
15224 r0_l(i) = ql_prim_rsz_vf(j, k, l, rs(i))
15225 r0_r(i) = qr_prim_rsz_vf(j + 1, k, l, rs(i))
15226
15227 v0_l(i) = ql_prim_rsz_vf(j, k, l, vs(i))
15228 v0_r(i) = qr_prim_rsz_vf(j + 1, k, l, vs(i))
15229 if (.not. polytropic .and. .not. qbmm) then
15230 p0_l(i) = ql_prim_rsz_vf(j, k, l, ps(i))
15231 p0_r(i) = qr_prim_rsz_vf(j + 1, k, l, ps(i))
15232 end if
15233 end do
15234
15235 if (.not. qbmm) then
15236 if (adv_n) then
15237 nbub_l = ql_prim_rsz_vf(j, k, l, n_idx)
15238 nbub_r = qr_prim_rsz_vf(j + 1, k, l, n_idx)
15239 else
15240 nbub_l = 0._wp
15241 nbub_r = 0._wp
15242
15243# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15244#if defined(MFC_OpenACC)
15245# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15246!$acc loop seq
15247# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15248#elif defined(MFC_OpenMP)
15249# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15250
15251# 2860 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15252#endif
15253 do i = 1, nb
15254 nbub_l = nbub_l + (r0_l(i)**3._wp)*weight(i)
15255 nbub_r = nbub_r + (r0_r(i)**3._wp)*weight(i)
15256 end do
15257
15258 nbub_l = (3._wp/(4._wp*pi))*ql_prim_rsz_vf(j, k, l, e_idx + num_fluids)/nbub_l
15259 nbub_r = (3._wp/(4._wp*pi))*qr_prim_rsz_vf(j + 1, k, l, e_idx + num_fluids)/nbub_r
15260 end if
15261 else
15262 !nb stored in 0th moment of first R0 bin in variable conversion module
15263 nbub_l = ql_prim_rsz_vf(j, k, l, bubxb)
15264 nbub_r = qr_prim_rsz_vf(j + 1, k, l, bubxb)
15265 end if
15266
15267
15268# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15269#if defined(MFC_OpenACC)
15270# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15271!$acc loop seq
15272# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15273#elif defined(MFC_OpenMP)
15274# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15275
15276# 2875 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15277#endif
15278 do i = 1, nb
15279 if (.not. qbmm) then
15280 pbw_l(i) = f_cpbw_km(r0(i), r0_l(i), v0_l(i), p0_l(i))
15281 pbw_r(i) = f_cpbw_km(r0(i), r0_r(i), v0_r(i), p0_r(i))
15282 end if
15283 end do
15284
15285 if (qbmm) then
15286 pbwr3lbar = mom_sp_rsz_vf(j, k, l, 4)
15287 pbwr3rbar = mom_sp_rsz_vf(j + 1, k, l, 4)
15288
15289 r3lbar = mom_sp_rsz_vf(j, k, l, 1)
15290 r3rbar = mom_sp_rsz_vf(j + 1, k, l, 1)
15291
15292 r3v2lbar = mom_sp_rsz_vf(j, k, l, 3)
15293 r3v2rbar = mom_sp_rsz_vf(j + 1, k, l, 3)
15294 else
15295
15296 pbwr3lbar = 0._wp
15297 pbwr3rbar = 0._wp
15298
15299 r3lbar = 0._wp
15300 r3rbar = 0._wp
15301
15302 r3v2lbar = 0._wp
15303 r3v2rbar = 0._wp
15304
15305
15306# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15307#if defined(MFC_OpenACC)
15308# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15309!$acc loop seq
15310# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15311#elif defined(MFC_OpenMP)
15312# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15313
15314# 2903 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15315#endif
15316 do i = 1, nb
15317 pbwr3lbar = pbwr3lbar + pbw_l(i)*(r0_l(i)**3._wp)*weight(i)
15318 pbwr3rbar = pbwr3rbar + pbw_r(i)*(r0_r(i)**3._wp)*weight(i)
15319
15320 r3lbar = r3lbar + (r0_l(i)**3._wp)*weight(i)
15321 r3rbar = r3rbar + (r0_r(i)**3._wp)*weight(i)
15322
15323 r3v2lbar = r3v2lbar + (r0_l(i)**3._wp)*(v0_l(i)**2._wp)*weight(i)
15324 r3v2rbar = r3v2rbar + (r0_r(i)**3._wp)*(v0_r(i)**2._wp)*weight(i)
15325 end do
15326 end if
15327
15328 rho_avg = 5.e-1_wp*(rho_l + rho_r)
15329 h_avg = 5.e-1_wp*(h_l + h_r)
15330 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
15331 qv_avg = 5.e-1_wp*(qv_l + qv_r)
15332 vel_avg_rms = 0._wp
15333
15334
15335# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15336#if defined(MFC_OpenACC)
15337# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15338!$acc loop seq
15339# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15340#elif defined(MFC_OpenMP)
15341# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15342
15343# 2922 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15344#endif
15345 do i = 1, num_dims
15346 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
15347 end do
15348
15349 end if
15350
15351 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
15352 vel_l_rms, 0._wp, c_l, qv_l)
15353
15354 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
15355 vel_r_rms, 0._wp, c_r, qv_r)
15356
15357 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
15358 ! variables are placeholders to call the subroutine.
15359 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
15360 vel_avg_rms, 0._wp, c_avg, qv_avg)
15361
15362 if (viscous) then
15363
15364# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15365#if defined(MFC_OpenACC)
15366# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15367!$acc loop seq
15368# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15369#elif defined(MFC_OpenMP)
15370# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15371
15372# 2941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15373#endif
15374 do i = 1, 2
15375 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
15376 end do
15377 end if
15378
15379 ! Low Mach correction
15380 if (low_mach == 2) then
15381
15382# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15383 if (riemann_solver == 1 .or. riemann_solver == 5) then
15384# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15385
15386# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15387 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
15388# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15389 pcorr = 0._wp
15390# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15391
15392# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15393 if (low_mach == 1) then
15394# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15395 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
15396# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15397 end if
15398# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15399
15400# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15401 else if (riemann_solver == 2) then
15402# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15403 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
15404# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15405 pcorr = 0._wp
15406# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15407
15408# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15409 if (low_mach == 1) then
15410# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15411 pcorr = rho_l*rho_r* &
15412# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15413 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
15414# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15415 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
15416# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15417 (zcoef - 1._wp)
15418# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15419 else if (low_mach == 2) then
15420# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15421 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))))
15422# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15423 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))))
15424# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15425 vel_l(dir_idx(1)) = vel_l_tmp
15426# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15427 vel_r(dir_idx(1)) = vel_r_tmp
15428# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15429 end if
15430# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15431 end if
15432# 2949 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15433
15434 end if
15435
15436 if (wave_speeds == 1) then
15437 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
15438 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
15439
15440 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
15441 (s_l - vel_l(dir_idx(1))) - &
15442 rho_r*vel_r(dir_idx(1))* &
15443 (s_r - vel_r(dir_idx(1)))) &
15444 /(rho_l*(s_l - vel_l(dir_idx(1))) - &
15445 rho_r*(s_r - vel_r(dir_idx(1))))
15446 elseif (wave_speeds == 2) then
15447 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
15448 (vel_l(dir_idx(1)) - &
15449 vel_r(dir_idx(1))))
15450
15451 pres_sr = pres_sl
15452
15453 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
15454 (pres_sl/pres_l - 1._wp)*pres_l/ &
15455 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
15456 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
15457 (pres_sr/pres_r - 1._wp)*pres_r/ &
15458 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
15459
15460 s_l = vel_l(dir_idx(1)) - c_l*ms_l
15461 s_r = vel_r(dir_idx(1)) + c_r*ms_r
15462
15463 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
15464 (pres_l - pres_r)/ &
15465 (rho_avg*c_avg))
15466 end if
15467
15468 ! follows Einfeldt et al.
15469 ! s_M/P = min/max(0.,s_L/R)
15470 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
15471
15472 ! goes with q_star_L/R = xi_L/R * (variable)
15473 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
15474 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
15475 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
15476
15477 ! goes with numerical velocity in x/y/z directions
15478 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
15479 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
15480 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
15481
15482 ! Low Mach correction
15483 if (low_mach == 1) then
15484
15485# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15486 if (riemann_solver == 1 .or. riemann_solver == 5) then
15487# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15488
15489# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15490 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
15491# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15492 pcorr = 0._wp
15493# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15494
15495# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15496 if (low_mach == 1) then
15497# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15498 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
15499# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15500 end if
15501# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15502
15503# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15504 else if (riemann_solver == 2) then
15505# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15506 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
15507# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15508 pcorr = 0._wp
15509# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15510
15511# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15512 if (low_mach == 1) then
15513# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15514 pcorr = rho_l*rho_r* &
15515# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15516 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
15517# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15518 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
15519# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15520 (zcoef - 1._wp)
15521# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15522 else if (low_mach == 2) then
15523# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15524 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))))
15525# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15526 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))))
15527# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15528 vel_l(dir_idx(1)) = vel_l_tmp
15529# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15530 vel_r(dir_idx(1)) = vel_r_tmp
15531# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15532 end if
15533# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15534 end if
15535# 3000 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15536
15537 else
15538 pcorr = 0._wp
15539 end if
15540
15541
15542# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15543#if defined(MFC_OpenACC)
15544# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15545!$acc loop seq
15546# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15547#elif defined(MFC_OpenMP)
15548# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15549
15550# 3005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15551#endif
15552 do i = 1, contxe
15553 flux_rsz_vf(j, k, l, i) = &
15554 xi_m*ql_prim_rsz_vf(j, k, l, i) &
15555 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15556 + xi_p*qr_prim_rsz_vf(j + 1, k, l, i) &
15557 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15558 end do
15559
15560 if (bubbles_euler .and. (num_fluids > 1)) then
15561 ! Kill mass transport @ gas density
15562 flux_rsz_vf(j, k, l, contxe) = 0._wp
15563 end if
15564
15565 ! Momentum flux.
15566 ! f = \rho u u + p I, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
15567
15568 ! Include p_tilde
15569
15570 if (avg_state == 2) then
15571 if (alpha_l(num_fluids) < small_alf .or. r3lbar < small_alf) then
15572 pres_l = pres_l - alpha_l(num_fluids)*pres_l
15573 else
15574 pres_l = pres_l - alpha_l(num_fluids)*(pres_l - pbwr3lbar/r3lbar - &
15575 rho_l*r3v2lbar/r3lbar)
15576 end if
15577
15578 if (alpha_r(num_fluids) < small_alf .or. r3rbar < small_alf) then
15579 pres_r = pres_r - alpha_r(num_fluids)*pres_r
15580 else
15581 pres_r = pres_r - alpha_r(num_fluids)*(pres_r - pbwr3rbar/r3rbar - &
15582 rho_r*r3v2rbar/r3rbar)
15583 end if
15584 end if
15585
15586
15587# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15588#if defined(MFC_OpenACC)
15589# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15590!$acc loop seq
15591# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15592#elif defined(MFC_OpenMP)
15593# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15594
15595# 3040 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15596#endif
15597 do i = 1, num_dims
15598 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
15599 xi_m*(rho_l*(vel_l(dir_idx(1))* &
15600 vel_l(dir_idx(i)) + &
15601 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
15602 (1._wp - dir_flg(dir_idx(i)))* &
15603 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
15604 dir_flg(dir_idx(i))*(pres_l)) &
15605 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
15606 vel_r(dir_idx(i)) + &
15607 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
15608 (1._wp - dir_flg(dir_idx(i)))* &
15609 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
15610 dir_flg(dir_idx(i))*(pres_r)) &
15611 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
15612 end do
15613
15614 ! Energy flux.
15615 ! f = u*(E+p), q = E, q_star = \xi*E+(s-u)(\rho s_star + p/(s-u))
15616 flux_rsz_vf(j, k, l, e_idx) = &
15617 xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + &
15618 s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
15619 (rho_l*s_s + (pres_l)/ &
15620 (s_l - vel_l(dir_idx(1))))) - e_l)) &
15621 + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + &
15622 s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
15623 (rho_r*s_s + (pres_r)/ &
15624 (s_r - vel_r(dir_idx(1))))) - e_r)) &
15625 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
15626
15627 ! Volume fraction flux
15628
15629# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15630#if defined(MFC_OpenACC)
15631# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15632!$acc loop seq
15633# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15634#elif defined(MFC_OpenMP)
15635# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15636
15637# 3072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15638#endif
15639 do i = advxb, advxe
15640 flux_rsz_vf(j, k, l, i) = &
15641 xi_m*ql_prim_rsz_vf(j, k, l, i) &
15642 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15643 + xi_p*qr_prim_rsz_vf(j + 1, k, l, i) &
15644 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15645 end do
15646
15647 ! Source for volume fraction advection equation
15648
15649# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15650#if defined(MFC_OpenACC)
15651# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15652!$acc loop seq
15653# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15654#elif defined(MFC_OpenMP)
15655# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15656
15657# 3082 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15658#endif
15659 do i = 1, num_dims
15660 vel_src_rsz_vf(j, k, l, dir_idx(i)) = &
15661 xi_m*(vel_l(dir_idx(i)) + &
15662 dir_flg(dir_idx(i))* &
15663 s_m*(xi_l - 1._wp)) &
15664 + xi_p*(vel_r(dir_idx(i)) + &
15665 dir_flg(dir_idx(i))* &
15666 s_p*(xi_r - 1._wp))
15667
15668 !IF ( (model_eqns == 4) .or. (num_fluids==1) ) vel_src_rs_vf(dir_idx(i))%sf(j,k,l) = 0._wp
15669 end do
15670
15671 flux_src_rsz_vf(j, k, l, advxb) = vel_src_rsz_vf(j, k, l, dir_idx(1))
15672
15673 ! Add advection flux for bubble variables
15674
15675# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15676#if defined(MFC_OpenACC)
15677# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15678!$acc loop seq
15679# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15680#elif defined(MFC_OpenMP)
15681# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15682
15683# 3098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15684#endif
15685 do i = bubxb, bubxe
15686 flux_rsz_vf(j, k, l, i) = &
15687 xi_m*nbub_l*ql_prim_rsz_vf(j, k, l, i) &
15688 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15689 + xi_p*nbub_r*qr_prim_rsz_vf(j + 1, k, l, i) &
15690 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15691 end do
15692
15693 if (qbmm) then
15694 flux_rsz_vf(j, k, l, bubxb) = &
15695 xi_m*nbub_l &
15696 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15697 + xi_p*nbub_r &
15698 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15699 end if
15700
15701 if (adv_n) then
15702 flux_rsz_vf(j, k, l, n_idx) = &
15703 xi_m*nbub_l &
15704 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
15705 + xi_p*nbub_r &
15706 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
15707 end if
15708
15709 ! Geometrical source flux for cylindrical coordinates
15710# 3150 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15711# 3151 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15712 if (grid_geometry == 3) then
15713
15714# 3152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15715#if defined(MFC_OpenACC)
15716# 3152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15717!$acc loop seq
15718# 3152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15719#elif defined(MFC_OpenMP)
15720# 3152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15721
15722# 3152 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15723#endif
15724 do i = 1, sys_size
15725 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
15726 end do
15727
15728 flux_gsrc_rsz_vf(j, k, l, momxb + 1) = &
15729 -xi_m*(rho_l*(vel_l(dir_idx(1))* &
15730 vel_l(dir_idx(1)) + &
15731 s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + &
15732 (1._wp - dir_flg(dir_idx(1)))* &
15733 vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
15734 - xi_p*(rho_r*(vel_r(dir_idx(1))* &
15735 vel_r(dir_idx(1)) + &
15736 s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + &
15737 (1._wp - dir_flg(dir_idx(1)))* &
15738 vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
15739 flux_gsrc_rsz_vf(j, k, l, momxe) = flux_rsz_vf(j, k, l, momxb + 1)
15740
15741 end if
15742# 3172 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15743 end do
15744 end do
15745 end do
15746
15747# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15748
15749# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15750#if defined(MFC_OpenACC)
15751# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15752!$acc end parallel loop
15753# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15754#elif defined(MFC_OpenMP)
15755# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15756
15757# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15758
15759# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15760!$omp end target teams loop
15761# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15762#endif
15763# 3175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15764
15765 else
15766 ! 5-EQUATION MODEL WITH HLLC
15767
15768# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15769
15770# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15771#if defined(MFC_OpenACC)
15772# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15773!$acc parallel loop collapse(3) gang vector default(present) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) copyin(is1, is2, is3)
15774# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15775#elif defined(MFC_OpenMP)
15776# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15777
15778# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15779
15780# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15781
15782# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15783!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer) private(Re_max, i, q, T_L, T_R, vel_L_rms, vel_R_rms, pres_L, pres_R, rho_L, gamma_L, pi_inf_L, qv_L, rho_R, gamma_R, pi_inf_R, qv_R, alpha_L_sum, alpha_R_sum, E_L, E_R, MW_L, MW_R, R_gas_L, R_gas_R, Cp_L, Cp_R, Cv_L, Cv_R, Gamm_L, Gamm_R, Y_L, Y_R, H_L, H_R, qv_avg, rho_avg, gamma_avg, H_avg, c_L, c_R, c_avg, s_P, s_M, xi_P, xi_M, xi_L, xi_R, Ms_L, Ms_R, pres_SL, pres_SR, vel_L, vel_R, Re_L, Re_R, alpha_L, alpha_R, s_L, s_R, s_S, vel_avg_rms, pcorr, zcoef, vel_L_tmp, vel_R_tmp, Ys_L, Ys_R, Xs_L, Xs_R, Gamma_iL, Gamma_iR, Cp_iL, Cp_iR, tau_e_L, tau_e_R, xi_field_L, xi_field_R, Yi_avg, Phi_avg, h_iL, h_iR, h_avg_2, G_L, G_R) map(to:is1, is2, is3)
15784# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15785#endif
15786# 3178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15787
15788 do l = is3%beg, is3%end
15789 do k = is2%beg, is2%end
15790 do j = is1%beg, is1%end
15791
15792 vel_l_rms = 0._wp; vel_r_rms = 0._wp
15793 rho_l = 0._wp; rho_r = 0._wp
15794 gamma_l = 0._wp; gamma_r = 0._wp
15795 pi_inf_l = 0._wp; pi_inf_r = 0._wp
15796 qv_l = 0._wp; qv_r = 0._wp
15797 alpha_l_sum = 0._wp; alpha_r_sum = 0._wp
15798
15799
15800# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15801#if defined(MFC_OpenACC)
15802# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15803!$acc loop seq
15804# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15805#elif defined(MFC_OpenMP)
15806# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15807
15808# 3190 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15809#endif
15810 do i = 1, num_fluids
15811 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
15812 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
15813 end do
15814
15815
15816# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15817#if defined(MFC_OpenACC)
15818# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15819!$acc loop seq
15820# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15821#elif defined(MFC_OpenMP)
15822# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15823
15824# 3196 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15825#endif
15826 do i = 1, num_dims
15827 vel_l(i) = ql_prim_rsz_vf(j, k, l, contxe + i)
15828 vel_r(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + i)
15829 vel_l_rms = vel_l_rms + vel_l(i)**2._wp
15830 vel_r_rms = vel_r_rms + vel_r(i)**2._wp
15831 end do
15832
15833 pres_l = ql_prim_rsz_vf(j, k, l, e_idx)
15834 pres_r = qr_prim_rsz_vf(j + 1, k, l, e_idx)
15835
15836 ! Change this by splitting it into the cases
15837 ! present in the bubbles_euler
15838 if (mpp_lim) then
15839
15840# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15841#if defined(MFC_OpenACC)
15842# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15843!$acc loop seq
15844# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15845#elif defined(MFC_OpenMP)
15846# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15847
15848# 3210 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15849#endif
15850 do i = 1, num_fluids
15851 ql_prim_rsz_vf(j, k, l, i) = max(0._wp, ql_prim_rsz_vf(j, k, l, i))
15852 ql_prim_rsz_vf(j, k, l, e_idx + i) = min(max(0._wp, ql_prim_rsz_vf(j, k, l, e_idx + i)), 1._wp)
15853 qr_prim_rsz_vf(j + 1, k, l, i) = max(0._wp, qr_prim_rsz_vf(j + 1, k, l, i))
15854 qr_prim_rsz_vf(j + 1, k, l, e_idx + i) = min(max(0._wp, qr_prim_rsz_vf(j + 1, k, l, e_idx + i)), 1._wp)
15855 alpha_l_sum = alpha_l_sum + ql_prim_rsz_vf(j, k, l, e_idx + i)
15856 alpha_r_sum = alpha_r_sum + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
15857 end do
15858
15859
15860# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15861#if defined(MFC_OpenACC)
15862# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15863!$acc loop seq
15864# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15865#elif defined(MFC_OpenMP)
15866# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15867
15868# 3220 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15869#endif
15870 do i = 1, num_fluids
15871 ql_prim_rsz_vf(j, k, l, e_idx + i) = ql_prim_rsz_vf(j, k, l, e_idx + i)/max(alpha_l_sum, sgm_eps)
15872 qr_prim_rsz_vf(j + 1, k, l, e_idx + i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)/max(alpha_r_sum, sgm_eps)
15873 end do
15874 end if
15875
15876
15877# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15878#if defined(MFC_OpenACC)
15879# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15880!$acc loop seq
15881# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15882#elif defined(MFC_OpenMP)
15883# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15884
15885# 3227 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15886#endif
15887 do i = 1, num_fluids
15888 rho_l = rho_l + ql_prim_rsz_vf(j, k, l, i)
15889 gamma_l = gamma_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*gammas(i)
15890 pi_inf_l = pi_inf_l + ql_prim_rsz_vf(j, k, l, e_idx + i)*pi_infs(i)
15891 qv_l = qv_l + ql_prim_rsz_vf(j, k, l, i)*qvs(i)
15892
15893 rho_r = rho_r + qr_prim_rsz_vf(j + 1, k, l, i)
15894 gamma_r = gamma_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*gammas(i)
15895 pi_inf_r = pi_inf_r + qr_prim_rsz_vf(j + 1, k, l, e_idx + i)*pi_infs(i)
15896 qv_r = qv_r + qr_prim_rsz_vf(j + 1, k, l, i)*qvs(i)
15897 end do
15898
15899 re_max = 0
15900 if (re_size(1) > 0) re_max = 1
15901 if (re_size(2) > 0) re_max = 2
15902
15903 if (viscous) then
15904
15905# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15906#if defined(MFC_OpenACC)
15907# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15908!$acc loop seq
15909# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15910#elif defined(MFC_OpenMP)
15911# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15912
15913# 3245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15914#endif
15915 do i = 1, re_max
15916 re_l(i) = 0._wp
15917 re_r(i) = 0._wp
15918
15919
15920# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15921#if defined(MFC_OpenACC)
15922# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15923!$acc loop seq
15924# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15925#elif defined(MFC_OpenMP)
15926# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15927
15928# 3250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15929#endif
15930 do q = 1, re_size(i)
15931 re_l(i) = alpha_l(re_idx(i, q))/res_gs(i, q) &
15932 + re_l(i)
15933 re_r(i) = alpha_r(re_idx(i, q))/res_gs(i, q) &
15934 + re_r(i)
15935 end do
15936
15937 re_l(i) = 1._wp/max(re_l(i), sgm_eps)
15938 re_r(i) = 1._wp/max(re_r(i), sgm_eps)
15939 end do
15940 end if
15941
15942 if (chemistry) then
15943 c_sum_yi_phi = 0.0_wp
15944
15945# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15946#if defined(MFC_OpenACC)
15947# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15948!$acc loop seq
15949# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15950#elif defined(MFC_OpenMP)
15951# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15952
15953# 3265 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15954#endif
15955 do i = chemxb, chemxe
15956 ys_l(i - chemxb + 1) = ql_prim_rsz_vf(j, k, l, i)
15957 ys_r(i - chemxb + 1) = qr_prim_rsz_vf(j + 1, k, l, i)
15958 end do
15959
15960 call get_mixture_molecular_weight(ys_l, mw_l)
15961 call get_mixture_molecular_weight(ys_r, mw_r)
15962
15963# 3278 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15964 xs_l(:) = ys_l(:)*mw_l/molecular_weights(:)
15965 xs_r(:) = ys_r(:)*mw_r/molecular_weights(:)
15966# 3281 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
15967
15968 r_gas_l = gas_constant/mw_l
15969 r_gas_r = gas_constant/mw_r
15970
15971 t_l = pres_l/rho_l/r_gas_l
15972 t_r = pres_r/rho_r/r_gas_r
15973
15974 call get_species_specific_heats_r(t_l, cp_il)
15975 call get_species_specific_heats_r(t_r, cp_ir)
15976
15977 if (chem_params%gamma_method == 1) then
15978 !> gamma_method = 1: Ref. Section 2.3.1 Formulation of doi:10.7907/ZKW8-ES97.
15979 gamma_il = cp_il/(cp_il - 1.0_wp)
15980 gamma_ir = cp_ir/(cp_ir - 1.0_wp)
15981
15982 gamma_l = sum(xs_l(:)/(gamma_il(:) - 1.0_wp))
15983 gamma_r = sum(xs_r(:)/(gamma_ir(:) - 1.0_wp))
15984 else if (chem_params%gamma_method == 2) then
15985 !> gamma_method = 2: c_p / c_v where c_p, c_v are specific heats.
15986 call get_mixture_specific_heat_cp_mass(t_l, ys_l, cp_l)
15987 call get_mixture_specific_heat_cp_mass(t_r, ys_r, cp_r)
15988 call get_mixture_specific_heat_cv_mass(t_l, ys_l, cv_l)
15989 call get_mixture_specific_heat_cv_mass(t_r, ys_r, cv_r)
15990
15991 gamm_l = cp_l/cv_l; gamm_r = cp_r/cv_r
15992 gamma_l = 1.0_wp/(gamm_l - 1.0_wp); gamma_r = 1.0_wp/(gamm_r - 1.0_wp)
15993 end if
15994
15995 call get_mixture_energy_mass(t_l, ys_l, e_l)
15996 call get_mixture_energy_mass(t_r, ys_r, e_r)
15997
15998 e_l = rho_l*e_l + 5.e-1*rho_l*vel_l_rms
15999 e_r = rho_r*e_r + 5.e-1*rho_r*vel_r_rms
16000 h_l = (e_l + pres_l)/rho_l
16001 h_r = (e_r + pres_r)/rho_r
16002 else
16003 e_l = gamma_l*pres_l + pi_inf_l + 5.e-1*rho_l*vel_l_rms + qv_l
16004 e_r = gamma_r*pres_r + pi_inf_r + 5.e-1*rho_r*vel_r_rms + qv_r
16005
16006 h_l = (e_l + pres_l)/rho_l
16007 h_r = (e_r + pres_r)/rho_r
16008 end if
16009
16010 ! ENERGY ADJUSTMENTS FOR HYPOELASTIC ENERGY
16011 if (hypoelasticity) then
16012
16013# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16014#if defined(MFC_OpenACC)
16015# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16016!$acc loop seq
16017# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16018#elif defined(MFC_OpenMP)
16019# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16020
16021# 3326 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16022#endif
16023 do i = 1, strxe - strxb + 1
16024 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
16025 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
16026 end do
16027 g_l = 0._wp
16028 g_r = 0._wp
16029
16030# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16031#if defined(MFC_OpenACC)
16032# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16033!$acc loop seq
16034# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16035#elif defined(MFC_OpenMP)
16036# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16037
16038# 3333 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16039#endif
16040 do i = 1, num_fluids
16041 g_l = g_l + alpha_l(i)*gs_rs(i)
16042 g_r = g_r + alpha_r(i)*gs_rs(i)
16043 end do
16044
16045# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16046#if defined(MFC_OpenACC)
16047# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16048!$acc loop seq
16049# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16050#elif defined(MFC_OpenMP)
16051# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16052
16053# 3338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16054#endif
16055 do i = 1, strxe - strxb + 1
16056 ! Elastic contribution to energy if G large enough
16057 if ((g_l > verysmall) .and. (g_r > verysmall)) then
16058 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
16059 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
16060 ! Additional terms in 2D and 3D
16061 if ((i == 2) .or. (i == 4) .or. (i == 5)) then
16062 e_l = e_l + (tau_e_l(i)*tau_e_l(i))/(4._wp*g_l)
16063 e_r = e_r + (tau_e_r(i)*tau_e_r(i))/(4._wp*g_r)
16064 end if
16065 end if
16066 end do
16067 end if
16068
16069 ! ENERGY ADJUSTMENTS FOR HYPERELASTIC ENERGY
16070 if (hyperelasticity) then
16071
16072# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16073#if defined(MFC_OpenACC)
16074# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16075!$acc loop seq
16076# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16077#elif defined(MFC_OpenMP)
16078# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16079
16080# 3355 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16081#endif
16082 do i = 1, num_dims
16083 xi_field_l(i) = ql_prim_rsz_vf(j, k, l, xibeg - 1 + i)
16084 xi_field_r(i) = qr_prim_rsz_vf(j + 1, k, l, xibeg - 1 + i)
16085 end do
16086 g_l = 0._wp
16087 g_r = 0._wp
16088
16089# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16090#if defined(MFC_OpenACC)
16091# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16092!$acc loop seq
16093# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16094#elif defined(MFC_OpenMP)
16095# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16096
16097# 3362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16098#endif
16099 do i = 1, num_fluids
16100 ! Mixture left and right shear modulus
16101 g_l = g_l + alpha_l(i)*gs_rs(i)
16102 g_r = g_r + alpha_r(i)*gs_rs(i)
16103 end do
16104 ! Elastic contribution to energy if G large enough
16105 if (g_l > verysmall .and. g_r > verysmall) then
16106 e_l = e_l + g_l*ql_prim_rsz_vf(j, k, l, xiend + 1)
16107 e_r = e_r + g_r*qr_prim_rsz_vf(j + 1, k, l, xiend + 1)
16108 end if
16109
16110# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16111#if defined(MFC_OpenACC)
16112# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16113!$acc loop seq
16114# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16115#elif defined(MFC_OpenMP)
16116# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16117
16118# 3373 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16119#endif
16120 do i = 1, b_size - 1
16121 tau_e_l(i) = ql_prim_rsz_vf(j, k, l, strxb - 1 + i)
16122 tau_e_r(i) = qr_prim_rsz_vf(j + 1, k, l, strxb - 1 + i)
16123 end do
16124 end if
16125
16126 h_l = (e_l + pres_l)/rho_l
16127 h_r = (e_r + pres_r)/rho_r
16128
16129
16130# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16131 if (avg_state == 1) then
16132# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16133
16134# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16135 rho_avg = sqrt(rho_l*rho_r)
16136# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16137
16138# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16139 vel_avg_rms = 0._wp
16140# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16141
16142# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16143
16144# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16145#if defined(MFC_OpenACC)
16146# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16147!$acc loop seq
16148# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16149#elif defined(MFC_OpenMP)
16150# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16151
16152# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16153#endif
16154# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16155 do i = 1, num_vels
16156# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16157 vel_avg_rms = vel_avg_rms + (sqrt(rho_l)*vel_l(i) + sqrt(rho_r)*vel_r(i))**2._wp/ &
16158# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16159 (sqrt(rho_l) + sqrt(rho_r))**2._wp
16160# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16161 end do
16162# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16163
16164# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16165 h_avg = (sqrt(rho_l)*h_l + sqrt(rho_r)*h_r)/ &
16166# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16167 (sqrt(rho_l) + sqrt(rho_r))
16168# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16169
16170# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16171 gamma_avg = (sqrt(rho_l)*gamma_l + sqrt(rho_r)*gamma_r)/ &
16172# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16173 (sqrt(rho_l) + sqrt(rho_r))
16174# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16175
16176# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16177 vel_avg_rms = (sqrt(rho_l)*vel_l(1) + sqrt(rho_r)*vel_r(1))**2._wp/ &
16178# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16179 (sqrt(rho_l) + sqrt(rho_r))**2._wp
16180# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16181
16182# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16183 qv_avg = (sqrt(rho_l)*qv_l + sqrt(rho_r)*qv_r)/ &
16184# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16185 (sqrt(rho_l) + sqrt(rho_r))
16186# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16187
16188# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16189 if (chemistry) then
16190# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16191 eps = 0.001_wp
16192# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16193 call get_species_enthalpies_rt(t_l, h_il)
16194# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16195 call get_species_enthalpies_rt(t_r, h_ir)
16196# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16197 h_il = h_il*gas_constant/molecular_weights*t_l
16198# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16199 h_ir = h_ir*gas_constant/molecular_weights*t_r
16200# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16201 call get_species_specific_heats_r(t_l, cp_il)
16202# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16203 call get_species_specific_heats_r(t_r, cp_ir)
16204# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16205
16206# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16207 h_avg_2 = (sqrt(rho_l)*h_il + sqrt(rho_r)*h_ir)/(sqrt(rho_l) + sqrt(rho_r))
16208# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16209 yi_avg = (sqrt(rho_l)*ys_l + sqrt(rho_r)*ys_r)/(sqrt(rho_l) + sqrt(rho_r))
16210# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16211 t_avg = (sqrt(rho_l)*t_l + sqrt(rho_r)*t_r)/(sqrt(rho_l) + sqrt(rho_r))
16212# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16213 if (abs(t_l - t_r) < eps) then
16214# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16215 ! Case when T_L and T_R are very close
16216# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16217 cp_avg = sum(yi_avg(:)*(0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:))
16218# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16219 cv_avg = sum(yi_avg(:)*((0.5_wp*cp_il(:) + 0.5_wp*cp_ir(:))*gas_constant/molecular_weights(:) - gas_constant/molecular_weights(:)))
16220# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16221 else
16222# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16223 ! Normal calculation when T_L and T_R are sufficiently different
16224# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16225 cp_avg = sum(yi_avg(:)*(h_ir(:) - h_il(:))/(t_r - t_l))
16226# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16227 cv_avg = sum(yi_avg(:)*((h_ir(:) - h_il(:))/(t_r - t_l) - gas_constant/molecular_weights(:)))
16228# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16229 end if
16230# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16231 gamma_avg = cp_avg/cv_avg
16232# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16233
16234# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16235 phi_avg(:) = (gamma_avg - 1._wp)*(vel_avg_rms/2.0_wp - h_avg_2(:)) + gamma_avg*gas_constant/molecular_weights(:)*t_avg
16236# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16237 c_sum_yi_phi = sum(yi_avg(:)*phi_avg(:))
16238# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16239
16240# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16241 end if
16242# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16243
16244# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16245 end if
16246# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16247
16248# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16249 if (avg_state == 2) then
16250# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16251 rho_avg = 5.e-1_wp*(rho_l + rho_r)
16252# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16253 vel_avg_rms = 0._wp
16254# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16255
16256# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16257#if defined(MFC_OpenACC)
16258# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16259!$acc loop seq
16260# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16261#elif defined(MFC_OpenMP)
16262# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16263
16264# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16265#endif
16266# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16267 do i = 1, num_vels
16268# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16269 vel_avg_rms = vel_avg_rms + (5.e-1_wp*(vel_l(i) + vel_r(i)))**2._wp
16270# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16271 end do
16272# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16273
16274# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16275 h_avg = 5.e-1_wp*(h_l + h_r)
16276# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16277 gamma_avg = 5.e-1_wp*(gamma_l + gamma_r)
16278# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16279 qv_avg = 5.e-1_wp*(qv_l + qv_r)
16280# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16281
16282# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16283 end if
16284# 3383 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16285
16286
16287 call s_compute_speed_of_sound(pres_l, rho_l, gamma_l, pi_inf_l, h_l, alpha_l, &
16288 vel_l_rms, 0._wp, c_l, qv_l)
16289
16290 call s_compute_speed_of_sound(pres_r, rho_r, gamma_r, pi_inf_r, h_r, alpha_r, &
16291 vel_r_rms, 0._wp, c_r, qv_r)
16292
16293 !> The computation of c_avg does not require all the variables, and therefore the non '_avg'
16294 ! variables are placeholders to call the subroutine.
16295 call s_compute_speed_of_sound(pres_r, rho_avg, gamma_avg, pi_inf_r, h_avg, alpha_r, &
16296 vel_avg_rms, c_sum_yi_phi, c_avg, qv_avg)
16297
16298 if (viscous) then
16299 if (chemistry) then
16300 call compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l(1), re_r(1))
16301 end if
16302
16303# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16304#if defined(MFC_OpenACC)
16305# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16306!$acc loop seq
16307# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16308#elif defined(MFC_OpenMP)
16309# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16310
16311# 3400 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16312#endif
16313 do i = 1, 2
16314 re_avg_rsz_vf(j, k, l, i) = 2._wp/(1._wp/re_l(i) + 1._wp/re_r(i))
16315 end do
16316 end if
16317
16318 ! Low Mach correction
16319 if (low_mach == 2) then
16320
16321# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16322 if (riemann_solver == 1 .or. riemann_solver == 5) then
16323# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16324
16325# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16326 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
16327# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16328 pcorr = 0._wp
16329# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16330
16331# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16332 if (low_mach == 1) then
16333# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16334 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
16335# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16336 end if
16337# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16338
16339# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16340 else if (riemann_solver == 2) then
16341# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16342 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
16343# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16344 pcorr = 0._wp
16345# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16346
16347# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16348 if (low_mach == 1) then
16349# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16350 pcorr = rho_l*rho_r* &
16351# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16352 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
16353# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16354 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
16355# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16356 (zcoef - 1._wp)
16357# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16358 else if (low_mach == 2) then
16359# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16360 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))))
16361# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16362 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))))
16363# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16364 vel_l(dir_idx(1)) = vel_l_tmp
16365# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16366 vel_r(dir_idx(1)) = vel_r_tmp
16367# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16368 end if
16369# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16370 end if
16371# 3408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16372
16373 end if
16374
16375 if (wave_speeds == 1) then
16376 if (elasticity) then
16377 s_l = min(vel_l(dir_idx(1)) - sqrt(c_l*c_l + &
16378 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l), vel_r(dir_idx(1)) - sqrt(c_r*c_r + &
16379 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r))
16380 s_r = max(vel_r(dir_idx(1)) + sqrt(c_r*c_r + &
16381 (((4._wp*g_r)/3._wp) + tau_e_r(dir_idx_tau(1)))/rho_r), vel_l(dir_idx(1)) + sqrt(c_l*c_l + &
16382 (((4._wp*g_l)/3._wp) + tau_e_l(dir_idx_tau(1)))/rho_l))
16383 s_s = (pres_r - tau_e_r(dir_idx_tau(1)) - pres_l + &
16384 tau_e_l(dir_idx_tau(1)) + rho_l*vel_l(dir_idx(1))*(s_l - vel_l(dir_idx(1))) - &
16385 rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1))))/(rho_l*(s_l - vel_l(dir_idx(1))) - &
16386 rho_r*(s_r - vel_r(dir_idx(1))))
16387 else
16388 s_l = min(vel_l(dir_idx(1)) - c_l, vel_r(dir_idx(1)) - c_r)
16389 s_r = max(vel_r(dir_idx(1)) + c_r, vel_l(dir_idx(1)) + c_l)
16390 s_s = (pres_r - pres_l + rho_l*vel_l(dir_idx(1))* &
16391 (s_l - vel_l(dir_idx(1))) - rho_r*vel_r(dir_idx(1))*(s_r - vel_r(dir_idx(1)))) &
16392 /(rho_l*(s_l - vel_l(dir_idx(1))) - rho_r*(s_r - vel_r(dir_idx(1))))
16393
16394 end if
16395 elseif (wave_speeds == 2) then
16396 pres_sl = 5.e-1_wp*(pres_l + pres_r + rho_avg*c_avg* &
16397 (vel_l(dir_idx(1)) - &
16398 vel_r(dir_idx(1))))
16399
16400 pres_sr = pres_sl
16401
16402 ms_l = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_l)/(1._wp + gamma_l))* &
16403 (pres_sl/pres_l - 1._wp)*pres_l/ &
16404 ((pres_l + pi_inf_l/(1._wp + gamma_l)))))
16405 ms_r = max(1._wp, sqrt(1._wp + ((5.e-1_wp + gamma_r)/(1._wp + gamma_r))* &
16406 (pres_sr/pres_r - 1._wp)*pres_r/ &
16407 ((pres_r + pi_inf_r/(1._wp + gamma_r)))))
16408
16409 s_l = vel_l(dir_idx(1)) - c_l*ms_l
16410 s_r = vel_r(dir_idx(1)) + c_r*ms_r
16411
16412 s_s = 5.e-1_wp*((vel_l(dir_idx(1)) + vel_r(dir_idx(1))) + &
16413 (pres_l - pres_r)/ &
16414 (rho_avg*c_avg))
16415 end if
16416
16417 ! follows Einfeldt et al.
16418 ! s_M/P = min/max(0.,s_L/R)
16419 s_m = min(0._wp, s_l); s_p = max(0._wp, s_r)
16420
16421 ! goes with q_star_L/R = xi_L/R * (variable)
16422 ! xi_L/R = ( ( s_L/R - u_L/R )/(s_L/R - s_star) )
16423 xi_l = (s_l - vel_l(dir_idx(1)))/(s_l - s_s)
16424 xi_r = (s_r - vel_r(dir_idx(1)))/(s_r - s_s)
16425
16426 ! goes with numerical velocity in x/y/z directions
16427 ! xi_P/M = 0.5 +/m sgn(0.5,s_star)
16428 xi_m = (5.e-1_wp + sign(5.e-1_wp, s_s))
16429 xi_p = (5.e-1_wp - sign(5.e-1_wp, s_s))
16430
16431 ! Low Mach correction
16432 if (low_mach == 1) then
16433
16434# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16435 if (riemann_solver == 1 .or. riemann_solver == 5) then
16436# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16437
16438# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16439 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
16440# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16441 pcorr = 0._wp
16442# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16443
16444# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16445 if (low_mach == 1) then
16446# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16447 pcorr = -(s_p - s_m)*(rho_l + rho_r)/8._wp*(zcoef - 1._wp)
16448# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16449 end if
16450# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16451
16452# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16453 else if (riemann_solver == 2) then
16454# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16455 zcoef = min(1._wp, max(vel_l_rms**5.e-1_wp/c_l, vel_r_rms**5.e-1_wp/c_r))
16456# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16457 pcorr = 0._wp
16458# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16459
16460# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16461 if (low_mach == 1) then
16462# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16463 pcorr = rho_l*rho_r* &
16464# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16465 (s_l - vel_l(dir_idx(1)))*(s_r - vel_r(dir_idx(1)))*(vel_r(dir_idx(1)) - vel_l(dir_idx(1)))/ &
16466# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16467 (rho_r*(s_r - vel_r(dir_idx(1))) - rho_l*(s_l - vel_l(dir_idx(1))))* &
16468# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16469 (zcoef - 1._wp)
16470# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16471 else if (low_mach == 2) then
16472# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16473 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))))
16474# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16475 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))))
16476# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16477 vel_l(dir_idx(1)) = vel_l_tmp
16478# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16479 vel_r(dir_idx(1)) = vel_r_tmp
16480# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16481 end if
16482# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16483 end if
16484# 3469 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16485
16486 else
16487 pcorr = 0._wp
16488 end if
16489
16490 ! COMPUTING THE HLLC FLUXES
16491 ! MASS FLUX.
16492
16493# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16494#if defined(MFC_OpenACC)
16495# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16496!$acc loop seq
16497# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16498#elif defined(MFC_OpenMP)
16499# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16500
16501# 3476 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16502#endif
16503 do i = 1, contxe
16504 flux_rsz_vf(j, k, l, i) = &
16505 xi_m*ql_prim_rsz_vf(j, k, l, i) &
16506 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
16507 + xi_p*qr_prim_rsz_vf(j + 1, k, l, i) &
16508 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
16509 end do
16510
16511 ! MOMENTUM FLUX.
16512 ! f = \rho u u - \sigma, q = \rho u, q_star = \xi * \rho*(s_star, v, w)
16513
16514# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16515#if defined(MFC_OpenACC)
16516# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16517!$acc loop seq
16518# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16519#elif defined(MFC_OpenMP)
16520# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16521
16522# 3487 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16523#endif
16524 do i = 1, num_dims
16525 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
16526 xi_m*(rho_l*(vel_l(dir_idx(1))* &
16527 vel_l(dir_idx(i)) + &
16528 s_m*(xi_l*(dir_flg(dir_idx(i))*s_s + &
16529 (1._wp - dir_flg(dir_idx(i)))* &
16530 vel_l(dir_idx(i))) - vel_l(dir_idx(i)))) + &
16531 dir_flg(dir_idx(i))*(pres_l)) &
16532 + xi_p*(rho_r*(vel_r(dir_idx(1))* &
16533 vel_r(dir_idx(i)) + &
16534 s_p*(xi_r*(dir_flg(dir_idx(i))*s_s + &
16535 (1._wp - dir_flg(dir_idx(i)))* &
16536 vel_r(dir_idx(i))) - vel_r(dir_idx(i)))) + &
16537 dir_flg(dir_idx(i))*(pres_r)) &
16538 + (s_m/s_l)*(s_p/s_r)*dir_flg(dir_idx(i))*pcorr
16539 end do
16540
16541 ! ENERGY FLUX.
16542 ! f = u*(E-\sigma), q = E, q_star = \xi*E+(s-u)(\rho s_star - \sigma/(s-u))
16543 flux_rsz_vf(j, k, l, e_idx) = &
16544 xi_m*(vel_l(dir_idx(1))*(e_l + pres_l) + &
16545 s_m*(xi_l*(e_l + (s_s - vel_l(dir_idx(1)))* &
16546 (rho_l*s_s + pres_l/ &
16547 (s_l - vel_l(dir_idx(1))))) - e_l)) &
16548 + xi_p*(vel_r(dir_idx(1))*(e_r + pres_r) + &
16549 s_p*(xi_r*(e_r + (s_s - vel_r(dir_idx(1)))* &
16550 (rho_r*s_s + pres_r/ &
16551 (s_r - vel_r(dir_idx(1))))) - e_r)) &
16552 + (s_m/s_l)*(s_p/s_r)*pcorr*s_s
16553
16554 ! ELASTICITY. Elastic shear stress additions for the momentum and energy flux
16555 if (elasticity) then
16556 flux_ene_e = 0._wp
16557
16558# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16559#if defined(MFC_OpenACC)
16560# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16561!$acc loop seq
16562# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16563#elif defined(MFC_OpenMP)
16564# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16565
16566# 3521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16567#endif
16568 do i = 1, num_dims
16569 ! MOMENTUM ELASTIC FLUX.
16570 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) = &
16571 flux_rsz_vf(j, k, l, contxe + dir_idx(i)) &
16572 - xi_m*tau_e_l(dir_idx_tau(i)) - xi_p*tau_e_r(dir_idx_tau(i))
16573 ! ENERGY ELASTIC FLUX.
16574 flux_ene_e = flux_ene_e - &
16575 xi_m*(vel_l(dir_idx(i))*tau_e_l(dir_idx_tau(i)) + &
16576 s_m*(xi_l*((s_s - vel_l(i))*(tau_e_l(dir_idx_tau(i))/(s_l - vel_l(i)))))) - &
16577 xi_p*(vel_r(dir_idx(i))*tau_e_r(dir_idx_tau(i)) + &
16578 s_p*(xi_r*((s_s - vel_r(i))*(tau_e_r(dir_idx_tau(i))/(s_r - vel_r(i))))))
16579 end do
16580 flux_rsz_vf(j, k, l, e_idx) = flux_rsz_vf(j, k, l, e_idx) + flux_ene_e
16581 end if
16582
16583 ! HYPOELASTIC STRESS EVOLUTION FLUX.
16584 if (hypoelasticity) then
16585
16586# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16587#if defined(MFC_OpenACC)
16588# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16589!$acc loop seq
16590# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16591#elif defined(MFC_OpenMP)
16592# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16593
16594# 3539 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16595#endif
16596 do i = 1, strxe - strxb + 1
16597 flux_rsz_vf(j, k, l, strxb - 1 + i) = &
16598 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*tau_e_l(i) - rho_l*vel_l(dir_idx(1))*tau_e_l(i)) + &
16599 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*tau_e_r(i) - rho_r*vel_r(dir_idx(1))*tau_e_r(i))
16600 end do
16601 end if
16602
16603 ! VOLUME FRACTION FLUX.
16604
16605# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16606#if defined(MFC_OpenACC)
16607# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16608!$acc loop seq
16609# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16610#elif defined(MFC_OpenMP)
16611# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16612
16613# 3548 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16614#endif
16615 do i = advxb, advxe
16616 flux_rsz_vf(j, k, l, i) = &
16617 xi_m*ql_prim_rsz_vf(j, k, l, i) &
16618 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
16619 + xi_p*qr_prim_rsz_vf(j + 1, k, l, i) &
16620 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
16621 end do
16622
16623 ! VOLUME FRACTION SOURCE FLUX.
16624
16625# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16626#if defined(MFC_OpenACC)
16627# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16628!$acc loop seq
16629# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16630#elif defined(MFC_OpenMP)
16631# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16632
16633# 3558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16634#endif
16635 do i = 1, num_dims
16636 vel_src_rsz_vf(j, k, l, dir_idx(i)) = &
16637 xi_m*(vel_l(dir_idx(i)) + &
16638 dir_flg(dir_idx(i))* &
16639 s_m*(xi_l - 1._wp)) &
16640 + xi_p*(vel_r(dir_idx(i)) + &
16641 dir_flg(dir_idx(i))* &
16642 s_p*(xi_r - 1._wp))
16643 end do
16644
16645 ! COLOR FUNCTION FLUX
16646 if (surface_tension) then
16647 flux_rsz_vf(j, k, l, c_idx) = &
16648 xi_m*ql_prim_rsz_vf(j, k, l, c_idx) &
16649 *(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
16650 + xi_p*qr_prim_rsz_vf(j + 1, k, l, c_idx) &
16651 *(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
16652 end if
16653
16654 ! REFERENCE MAP FLUX.
16655 if (hyperelasticity) then
16656
16657# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16658#if defined(MFC_OpenACC)
16659# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16660!$acc loop seq
16661# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16662#elif defined(MFC_OpenMP)
16663# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16664
16665# 3580 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16666#endif
16667 do i = 1, num_dims
16668 flux_rsz_vf(j, k, l, xibeg - 1 + i) = &
16669 xi_m*(s_s/(s_l - s_s))*(s_l*rho_l*xi_field_l(i) &
16670 - rho_l*vel_l(dir_idx(1))*xi_field_l(i)) + &
16671 xi_p*(s_s/(s_r - s_s))*(s_r*rho_r*xi_field_r(i) &
16672 - rho_r*vel_r(dir_idx(1))*xi_field_r(i))
16673 end do
16674 end if
16675
16676 flux_src_rsz_vf(j, k, l, advxb) = vel_src_rsz_vf(j, k, l, dir_idx(1))
16677
16678 if (chemistry) then
16679
16680# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16681#if defined(MFC_OpenACC)
16682# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16683!$acc loop seq
16684# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16685#elif defined(MFC_OpenMP)
16686# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16687
16688# 3593 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16689#endif
16690 do i = chemxb, chemxe
16691 y_l = ql_prim_rsz_vf(j, k, l, i)
16692 y_r = qr_prim_rsz_vf(j + 1, k, l, i)
16693
16694 flux_rsz_vf(j, k, l, i) = xi_m*rho_l*y_l*(vel_l(dir_idx(1)) + s_m*(xi_l - 1._wp)) &
16695 + xi_p*rho_r*y_r*(vel_r(dir_idx(1)) + s_p*(xi_r - 1._wp))
16696 flux_src_rsz_vf(j, k, l, i) = 0.0_wp
16697 end do
16698 end if
16699
16700 ! Geometrical source flux for cylindrical coordinates
16701# 3631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16702# 3632 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16703 if (grid_geometry == 3) then
16704
16705# 3633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16706#if defined(MFC_OpenACC)
16707# 3633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16708!$acc loop seq
16709# 3633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16710#elif defined(MFC_OpenMP)
16711# 3633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16712
16713# 3633 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16714#endif
16715 do i = 1, sys_size
16716 flux_gsrc_rsz_vf(j, k, l, i) = 0._wp
16717 end do
16718
16719 flux_gsrc_rsz_vf(j, k, l, momxb + 1) = &
16720 -xi_m*(rho_l*(vel_l(dir_idx(1))* &
16721 vel_l(dir_idx(1)) + &
16722 s_m*(xi_l*(dir_flg(dir_idx(1))*s_s + &
16723 (1._wp - dir_flg(dir_idx(1)))* &
16724 vel_l(dir_idx(1))) - vel_l(dir_idx(1))))) &
16725 - xi_p*(rho_r*(vel_r(dir_idx(1))* &
16726 vel_r(dir_idx(1)) + &
16727 s_p*(xi_r*(dir_flg(dir_idx(1))*s_s + &
16728 (1._wp - dir_flg(dir_idx(1)))* &
16729 vel_r(dir_idx(1))) - vel_r(dir_idx(1)))))
16730 flux_gsrc_rsz_vf(j, k, l, momxe) = flux_rsz_vf(j, k, l, momxb + 1)
16731
16732 end if
16733# 3653 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16734
16735 end do
16736 end do
16737 end do
16738
16739# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16740
16741# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16742#if defined(MFC_OpenACC)
16743# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16744!$acc end parallel loop
16745# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16746#elif defined(MFC_OpenMP)
16747# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16748
16749# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16750
16751# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16752!$omp end target teams loop
16753# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16754#endif
16755# 3657 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16756
16757 end if
16758 end if
16759# 3661 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16760 ! Computing HLLC flux and source flux for Euler system of equations
16761
16762 if (viscous .or. dummy) then
16763 if (weno_re_flux) then
16764 call s_compute_viscous_source_flux( &
16765 ql_prim_vf(momxb:momxe), &
16766 dql_prim_dx_vf(momxb:momxe), &
16767 dql_prim_dy_vf(momxb:momxe), &
16768 dql_prim_dz_vf(momxb:momxe), &
16769 qr_prim_vf(momxb:momxe), &
16770 dqr_prim_dx_vf(momxb:momxe), &
16771 dqr_prim_dy_vf(momxb:momxe), &
16772 dqr_prim_dz_vf(momxb:momxe), &
16773 flux_src_vf, norm_dir, ix, iy, iz)
16774 else
16775 call s_compute_viscous_source_flux( &
16776 q_prim_vf(momxb:momxe), &
16777 dql_prim_dx_vf(momxb:momxe), &
16778 dql_prim_dy_vf(momxb:momxe), &
16779 dql_prim_dz_vf(momxb:momxe), &
16780 q_prim_vf(momxb:momxe), &
16781 dqr_prim_dx_vf(momxb:momxe), &
16782 dqr_prim_dy_vf(momxb:momxe), &
16783 dqr_prim_dz_vf(momxb:momxe), &
16784 flux_src_vf, norm_dir, ix, iy, iz)
16785 end if
16786 end if
16787
16788 if (surface_tension) then
16789 call s_compute_capillary_source_flux( &
16790 vel_src_rsx_vf, &
16791 vel_src_rsy_vf, &
16792 vel_src_rsz_vf, &
16793 flux_src_vf, &
16794 norm_dir, isx, isy, isz)
16795 end if
16796
16797 call s_finalize_riemann_solver(flux_vf, flux_src_vf, &
16798 flux_gsrc_vf, &
16799 norm_dir)
16800
16801 end subroutine s_hllc_riemann_solver
16802
16803 !> HLLD Riemann solver resolves 5 of the 7 waves of MHD equations:
16804 !! 1 entropy wave, 2 Alfvén waves, 2 fast magnetosonic waves.
16805 subroutine s_hlld_riemann_solver(qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, &
16806 dqL_prim_dx_vf, dqL_prim_dy_vf, dqL_prim_dz_vf, &
16807 qL_prim_vf, &
16808 qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, &
16809 dqR_prim_dx_vf, dqR_prim_dy_vf, dqR_prim_dz_vf, &
16810 qR_prim_vf, &
16811 q_prim_vf, &
16812 flux_vf, flux_src_vf, flux_gsrc_vf, &
16813 norm_dir, ix, iy, iz)
16814
16815 real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(inout) :: ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, &
16816 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf
16817
16818 type(scalar_field), allocatable, dimension(:), intent(inout) :: dql_prim_dx_vf, dqr_prim_dx_vf, &
16819 dql_prim_dy_vf, dqr_prim_dy_vf, &
16820 dql_prim_dz_vf, dqr_prim_dz_vf
16821
16822 type(scalar_field), allocatable, dimension(:), intent(inout) :: ql_prim_vf, qr_prim_vf
16823
16824 type(scalar_field), dimension(sys_size), intent(in) :: q_prim_vf
16825 type(scalar_field), dimension(sys_size), intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
16826
16827 integer, intent(in) :: norm_dir
16828 type(int_bounds_info), intent(in) :: ix, iy, iz
16829
16830 ! Local variables:
16831# 3735 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16832 real(wp), dimension(num_fluids) :: alpha_l, alpha_r, alpha_rho_l, alpha_rho_r
16833# 3737 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16834 type(riemann_states_vec3) :: vel
16835 type(riemann_states) :: rho, pres, e, h_no_mag
16836 type(riemann_states) :: gamma, pi_inf, qv
16837 type(riemann_states) :: vel_rms
16838
16839 type(riemann_states_vec3) :: b
16840 type(riemann_states) :: c, c_fast, pres_mag
16841
16842 ! HLLD speeds and intermediate state variables:
16843 real(wp) :: s_l, s_r, s_m, s_starl, s_starr
16844 real(wp) :: ptot_l, ptot_r, p_star, rhol_star, rhor_star, e_starl, e_starr
16845
16846 real(wp), dimension(7) :: u_l, u_r, u_starl, u_starr, u_doublel, u_doubler
16847 real(wp), dimension(7) :: f_l, f_r, f_starl, f_starr, f_hlld
16848
16849 ! Indices for U and F: (rho, rho*vel(1), rho*vel(2), rho*vel(3), By, Bz, E)
16850 ! Note: vel and B are permutated, so vel(1) is the normal velocity, and x is the normal direction
16851 ! Note: Bx is omitted as the magnetic flux is always zero in the normal direction
16852
16853 real(wp) :: sqrt_rhol_star, sqrt_rhor_star, denom_ds, sign_bx
16854 real(wp) :: vl_star, vr_star, wl_star, wr_star
16855 real(wp) :: v_double, w_double, by_double, bz_double, e_doublel, e_doubler, e_double
16856
16857 integer :: i, j, k, l
16858
16859 call s_populate_riemann_states_variables_buffers( &
16860 ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, &
16861 dql_prim_dy_vf, dql_prim_dz_vf, &
16862 qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, &
16863 dqr_prim_dy_vf, dqr_prim_dz_vf, &
16864 norm_dir, ix, iy, iz)
16865
16866 call s_initialize_riemann_solver( &
16867 flux_src_vf, norm_dir)
16868
16869# 3773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16870 if (norm_dir == 1) then
16871
16872# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16873
16874# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16875#if defined(MFC_OpenACC)
16876# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16877!$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)
16878# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16879#elif defined(MFC_OpenMP)
16880# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16881
16882# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16883
16884# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16885
16886# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16887!$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)
16888# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16889#endif
16890# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16891
16892 do l = is3%beg, is3%end
16893 do k = is2%beg, is2%end
16894 do j = is1%beg, is1%end
16895
16896 ! (1) Extract the left/right primitive states
16897 do i = 1, contxe
16898 alpha_rho_l(i) = ql_prim_rsx_vf(j, k, l, i)
16899 alpha_rho_r(i) = qr_prim_rsx_vf(j + 1, k, l, i)
16900 end do
16901
16902 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
16903 do i = 1, num_vels
16904 vel%L(i) = ql_prim_rsx_vf(j, k, l, contxe + dir_idx(i))
16905 vel%R(i) = qr_prim_rsx_vf(j + 1, k, l, contxe + dir_idx(i))
16906 end do
16907
16908 vel_rms%L = sum(vel%L**2._wp)
16909 vel_rms%R = sum(vel%R**2._wp)
16910
16911 do i = 1, num_fluids
16912 alpha_l(i) = ql_prim_rsx_vf(j, k, l, e_idx + i)
16913 alpha_r(i) = qr_prim_rsx_vf(j + 1, k, l, e_idx + i)
16914 end do
16915
16916 pres%L = ql_prim_rsx_vf(j, k, l, e_idx)
16917 pres%R = qr_prim_rsx_vf(j + 1, k, l, e_idx)
16918
16919 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
16920 if (mhd) then
16921 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
16922 b%L = [bx0, ql_prim_rsx_vf(j, k, l, b_idx%beg), ql_prim_rsx_vf(j, k, l, b_idx%beg + 1)]
16923 b%R = [bx0, qr_prim_rsx_vf(j + 1, k, l, b_idx%beg), qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + 1)]
16924 else ! 2D/3D: Bx, By, Bz as variables
16925 b%L = [ql_prim_rsx_vf(j, k, l, b_idx%beg + dir_idx(1) - 1), &
16926 ql_prim_rsx_vf(j, k, l, b_idx%beg + dir_idx(2) - 1), &
16927 ql_prim_rsx_vf(j, k, l, b_idx%beg + dir_idx(3) - 1)]
16928 b%R = [qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + dir_idx(1) - 1), &
16929 qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + dir_idx(2) - 1), &
16930 qr_prim_rsx_vf(j + 1, k, l, b_idx%beg + dir_idx(3) - 1)]
16931 end if
16932 end if
16933
16934 ! Sum properties of all fluid components
16935 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
16936 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
16937
16938# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16939#if defined(MFC_OpenACC)
16940# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16941!$acc loop seq
16942# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16943#elif defined(MFC_OpenMP)
16944# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16945
16946# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
16947#endif
16948 do i = 1, num_fluids
16949 rho%L = rho%L + alpha_rho_l(i)
16950 gamma%L = gamma%L + alpha_l(i)*gammas(i)
16951 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
16952 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
16953
16954 rho%R = rho%R + alpha_rho_r(i)
16955 gamma%R = gamma%R + alpha_r(i)*gammas(i)
16956 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
16957 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
16958 end do
16959
16960 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
16961 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
16962 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
16963 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
16964 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
16965 h_no_mag%R = (e%R + pres%R - pres_mag%R)/rho%R ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
16966
16967 ! (2) Compute fast wave speeds
16968 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, 0._wp, c%L, qv%L)
16969 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, 0._wp, c%R, qv%R)
16970 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
16971 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
16972
16973 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
16974 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
16975 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
16976
16977 ptot_l = pres%L + pres_mag%L
16978 ptot_r = pres%R + pres_mag%R
16979
16980 s_m = (((s_r - vel%R(1))*rho%R*vel%R(1) - &
16981 (s_l - vel%L(1))*rho%L*vel%L(1) - ptot_r + ptot_l)/ &
16982 ((s_r - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
16983
16984 ! (4) Compute star state variables
16985 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
16986 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
16987 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
16988 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
16989 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
16990
16991 ! (5) Compute left/right state vectors and fluxes
16992 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
16993 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
16994 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
16995 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
16996
16997 ! Compute the left/right fluxes
16998 f_l(1) = u_l(2)
16999 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
17000 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
17001 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
17002 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))
17003
17004 f_r(1) = u_r(2)
17005 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
17006 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
17007 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
17008 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))
17009 ! Compute the star flux using HLL relation
17010 f_starl = f_l + s_l*(u_starl - u_l)
17011 f_starr = f_r + s_r*(u_starr - u_r)
17012 ! Compute the rotational (Alfvén) speeds
17013 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
17014 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
17015 ! Compute the double–star states [Miyoshi Eqns. (59)-(62)]
17016 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
17017 vl_star = vel%L(2); wl_star = vel%L(3)
17018 vr_star = vel%R(2); wr_star = vel%R(3)
17019
17020 ! (6) Compute the double–star states [Miyoshi Eqns. (59)-(62)]
17021 denom_ds = sqrt_rhol_star + sqrt_rhor_star
17022 sign_bx = sign(1._wp, b%L(1))
17023 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
17024 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
17025 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star - vl_star)*sign_bx)/denom_ds
17026 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star - wl_star)*sign_bx)/denom_ds
17027
17028 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double + w_double*bz_double))*sign_bx
17029 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double + w_double*bz_double))*sign_bx
17030 e_double = 0.5_wp*(e_doublel + e_doubler)
17031
17032 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, e_double]
17033 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, e_double]
17034
17035 ! (11) Choose HLLD flux based on wave-speed regions
17036 if (0.0_wp <= s_l) then
17037 f_hlld = f_l
17038 else if (0.0_wp <= s_starl) then
17039 f_hlld = f_l + s_l*(u_starl - u_l)
17040 else if (0.0_wp <= s_m) then
17041 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
17042 else if (0.0_wp <= s_starr) then
17043 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
17044 else if (0.0_wp <= s_r) then
17045 f_hlld = f_r + s_r*(u_starr - u_r)
17046 else
17047 f_hlld = f_r
17048 end if
17049
17050 ! (12) Reorder and write temporary variables to the flux array
17051 ! Mass
17052 flux_rsx_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
17053 ! Momentum
17054 flux_rsx_vf(j, k, l, contxe + dir_idx(1)) = f_hlld(2)
17055 flux_rsx_vf(j, k, l, contxe + dir_idx(2)) = f_hlld(3)
17056 flux_rsx_vf(j, k, l, contxe + dir_idx(3)) = f_hlld(4)
17057 ! Magnetic field
17058 if (n == 0) then
17059 flux_rsx_vf(j, k, l, b_idx%beg) = f_hlld(5)
17060 flux_rsx_vf(j, k, l, b_idx%beg + 1) = f_hlld(6)
17061 else
17062 flux_rsx_vf(j, k, l, b_idx%beg + dir_idx(2) - 1) = f_hlld(5)
17063 flux_rsx_vf(j, k, l, b_idx%beg + dir_idx(3) - 1) = f_hlld(6)
17064 end if
17065 ! Energy
17066 flux_rsx_vf(j, k, l, e_idx) = f_hlld(7)
17067 ! Partial fraction
17068
17069# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17070#if defined(MFC_OpenACC)
17071# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17072!$acc loop seq
17073# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17074#elif defined(MFC_OpenMP)
17075# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17076
17077# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17078#endif
17079 do i = advxb, advxe
17080 flux_rsx_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
17081 end do
17082
17083 flux_src_rsx_vf(j, k, l, advxb) = 0._wp
17084 end do
17085 end do
17086 end do
17087
17088# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17089
17090# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17091#if defined(MFC_OpenACC)
17092# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17093!$acc end parallel loop
17094# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17095#elif defined(MFC_OpenMP)
17096# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17097
17098# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17099
17100# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17101!$omp end target teams loop
17102# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17103#endif
17104# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17105
17106 end if
17107# 3773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17108 if (norm_dir == 2) then
17109
17110# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17111
17112# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17113#if defined(MFC_OpenACC)
17114# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17115!$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)
17116# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17117#elif defined(MFC_OpenMP)
17118# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17119
17120# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17121
17122# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17123
17124# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17125!$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)
17126# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17127#endif
17128# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17129
17130 do l = is3%beg, is3%end
17131 do k = is2%beg, is2%end
17132 do j = is1%beg, is1%end
17133
17134 ! (1) Extract the left/right primitive states
17135 do i = 1, contxe
17136 alpha_rho_l(i) = ql_prim_rsy_vf(j, k, l, i)
17137 alpha_rho_r(i) = qr_prim_rsy_vf(j + 1, k, l, i)
17138 end do
17139
17140 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
17141 do i = 1, num_vels
17142 vel%L(i) = ql_prim_rsy_vf(j, k, l, contxe + dir_idx(i))
17143 vel%R(i) = qr_prim_rsy_vf(j + 1, k, l, contxe + dir_idx(i))
17144 end do
17145
17146 vel_rms%L = sum(vel%L**2._wp)
17147 vel_rms%R = sum(vel%R**2._wp)
17148
17149 do i = 1, num_fluids
17150 alpha_l(i) = ql_prim_rsy_vf(j, k, l, e_idx + i)
17151 alpha_r(i) = qr_prim_rsy_vf(j + 1, k, l, e_idx + i)
17152 end do
17153
17154 pres%L = ql_prim_rsy_vf(j, k, l, e_idx)
17155 pres%R = qr_prim_rsy_vf(j + 1, k, l, e_idx)
17156
17157 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
17158 if (mhd) then
17159 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
17160 b%L = [bx0, ql_prim_rsy_vf(j, k, l, b_idx%beg), ql_prim_rsy_vf(j, k, l, b_idx%beg + 1)]
17161 b%R = [bx0, qr_prim_rsy_vf(j + 1, k, l, b_idx%beg), qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + 1)]
17162 else ! 2D/3D: Bx, By, Bz as variables
17163 b%L = [ql_prim_rsy_vf(j, k, l, b_idx%beg + dir_idx(1) - 1), &
17164 ql_prim_rsy_vf(j, k, l, b_idx%beg + dir_idx(2) - 1), &
17165 ql_prim_rsy_vf(j, k, l, b_idx%beg + dir_idx(3) - 1)]
17166 b%R = [qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + dir_idx(1) - 1), &
17167 qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + dir_idx(2) - 1), &
17168 qr_prim_rsy_vf(j + 1, k, l, b_idx%beg + dir_idx(3) - 1)]
17169 end if
17170 end if
17171
17172 ! Sum properties of all fluid components
17173 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
17174 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
17175
17176# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17177#if defined(MFC_OpenACC)
17178# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17179!$acc loop seq
17180# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17181#elif defined(MFC_OpenMP)
17182# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17183
17184# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17185#endif
17186 do i = 1, num_fluids
17187 rho%L = rho%L + alpha_rho_l(i)
17188 gamma%L = gamma%L + alpha_l(i)*gammas(i)
17189 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
17190 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
17191
17192 rho%R = rho%R + alpha_rho_r(i)
17193 gamma%R = gamma%R + alpha_r(i)*gammas(i)
17194 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
17195 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
17196 end do
17197
17198 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
17199 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
17200 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
17201 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
17202 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
17203 h_no_mag%R = (e%R + pres%R - pres_mag%R)/rho%R ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
17204
17205 ! (2) Compute fast wave speeds
17206 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, 0._wp, c%L, qv%L)
17207 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, 0._wp, c%R, qv%R)
17208 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
17209 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
17210
17211 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
17212 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
17213 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
17214
17215 ptot_l = pres%L + pres_mag%L
17216 ptot_r = pres%R + pres_mag%R
17217
17218 s_m = (((s_r - vel%R(1))*rho%R*vel%R(1) - &
17219 (s_l - vel%L(1))*rho%L*vel%L(1) - ptot_r + ptot_l)/ &
17220 ((s_r - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
17221
17222 ! (4) Compute star state variables
17223 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
17224 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
17225 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
17226 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
17227 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
17228
17229 ! (5) Compute left/right state vectors and fluxes
17230 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
17231 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
17232 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
17233 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
17234
17235 ! Compute the left/right fluxes
17236 f_l(1) = u_l(2)
17237 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
17238 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
17239 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
17240 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))
17241
17242 f_r(1) = u_r(2)
17243 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
17244 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
17245 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
17246 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))
17247 ! Compute the star flux using HLL relation
17248 f_starl = f_l + s_l*(u_starl - u_l)
17249 f_starr = f_r + s_r*(u_starr - u_r)
17250 ! Compute the rotational (Alfvén) speeds
17251 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
17252 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
17253 ! Compute the double–star states [Miyoshi Eqns. (59)-(62)]
17254 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
17255 vl_star = vel%L(2); wl_star = vel%L(3)
17256 vr_star = vel%R(2); wr_star = vel%R(3)
17257
17258 ! (6) Compute the double–star states [Miyoshi Eqns. (59)-(62)]
17259 denom_ds = sqrt_rhol_star + sqrt_rhor_star
17260 sign_bx = sign(1._wp, b%L(1))
17261 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
17262 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
17263 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star - vl_star)*sign_bx)/denom_ds
17264 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star - wl_star)*sign_bx)/denom_ds
17265
17266 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double + w_double*bz_double))*sign_bx
17267 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double + w_double*bz_double))*sign_bx
17268 e_double = 0.5_wp*(e_doublel + e_doubler)
17269
17270 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, e_double]
17271 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, e_double]
17272
17273 ! (11) Choose HLLD flux based on wave-speed regions
17274 if (0.0_wp <= s_l) then
17275 f_hlld = f_l
17276 else if (0.0_wp <= s_starl) then
17277 f_hlld = f_l + s_l*(u_starl - u_l)
17278 else if (0.0_wp <= s_m) then
17279 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
17280 else if (0.0_wp <= s_starr) then
17281 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
17282 else if (0.0_wp <= s_r) then
17283 f_hlld = f_r + s_r*(u_starr - u_r)
17284 else
17285 f_hlld = f_r
17286 end if
17287
17288 ! (12) Reorder and write temporary variables to the flux array
17289 ! Mass
17290 flux_rsy_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
17291 ! Momentum
17292 flux_rsy_vf(j, k, l, contxe + dir_idx(1)) = f_hlld(2)
17293 flux_rsy_vf(j, k, l, contxe + dir_idx(2)) = f_hlld(3)
17294 flux_rsy_vf(j, k, l, contxe + dir_idx(3)) = f_hlld(4)
17295 ! Magnetic field
17296 if (n == 0) then
17297 flux_rsy_vf(j, k, l, b_idx%beg) = f_hlld(5)
17298 flux_rsy_vf(j, k, l, b_idx%beg + 1) = f_hlld(6)
17299 else
17300 flux_rsy_vf(j, k, l, b_idx%beg + dir_idx(2) - 1) = f_hlld(5)
17301 flux_rsy_vf(j, k, l, b_idx%beg + dir_idx(3) - 1) = f_hlld(6)
17302 end if
17303 ! Energy
17304 flux_rsy_vf(j, k, l, e_idx) = f_hlld(7)
17305 ! Partial fraction
17306
17307# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17308#if defined(MFC_OpenACC)
17309# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17310!$acc loop seq
17311# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17312#elif defined(MFC_OpenMP)
17313# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17314
17315# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17316#endif
17317 do i = advxb, advxe
17318 flux_rsy_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
17319 end do
17320
17321 flux_src_rsy_vf(j, k, l, advxb) = 0._wp
17322 end do
17323 end do
17324 end do
17325
17326# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17327
17328# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17329#if defined(MFC_OpenACC)
17330# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17331!$acc end parallel loop
17332# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17333#elif defined(MFC_OpenMP)
17334# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17335
17336# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17337
17338# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17339!$omp end target teams loop
17340# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17341#endif
17342# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17343
17344 end if
17345# 3773 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17346 if (norm_dir == 3) then
17347
17348# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17349
17350# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17351#if defined(MFC_OpenACC)
17352# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17353!$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)
17354# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17355#elif defined(MFC_OpenMP)
17356# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17357
17358# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17359
17360# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17361
17362# 3774 "/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) 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)
17364# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17365#endif
17366# 3774 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17367
17368 do l = is3%beg, is3%end
17369 do k = is2%beg, is2%end
17370 do j = is1%beg, is1%end
17371
17372 ! (1) Extract the left/right primitive states
17373 do i = 1, contxe
17374 alpha_rho_l(i) = ql_prim_rsz_vf(j, k, l, i)
17375 alpha_rho_r(i) = qr_prim_rsz_vf(j + 1, k, l, i)
17376 end do
17377
17378 ! NOTE: unlike HLL & HLLC, vel_L here is permutated by dir_idx for simpler logic
17379 do i = 1, num_vels
17380 vel%L(i) = ql_prim_rsz_vf(j, k, l, contxe + dir_idx(i))
17381 vel%R(i) = qr_prim_rsz_vf(j + 1, k, l, contxe + dir_idx(i))
17382 end do
17383
17384 vel_rms%L = sum(vel%L**2._wp)
17385 vel_rms%R = sum(vel%R**2._wp)
17386
17387 do i = 1, num_fluids
17388 alpha_l(i) = ql_prim_rsz_vf(j, k, l, e_idx + i)
17389 alpha_r(i) = qr_prim_rsz_vf(j + 1, k, l, e_idx + i)
17390 end do
17391
17392 pres%L = ql_prim_rsz_vf(j, k, l, e_idx)
17393 pres%R = qr_prim_rsz_vf(j + 1, k, l, e_idx)
17394
17395 ! NOTE: unlike HLL, Bx, By, Bz are permutated by dir_idx for simpler logic
17396 if (mhd) then
17397 if (n == 0) then ! 1D: constant Bx; By, Bz as variables; only in x so not permutated
17398 b%L = [bx0, ql_prim_rsz_vf(j, k, l, b_idx%beg), ql_prim_rsz_vf(j, k, l, b_idx%beg + 1)]
17399 b%R = [bx0, qr_prim_rsz_vf(j + 1, k, l, b_idx%beg), qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + 1)]
17400 else ! 2D/3D: Bx, By, Bz as variables
17401 b%L = [ql_prim_rsz_vf(j, k, l, b_idx%beg + dir_idx(1) - 1), &
17402 ql_prim_rsz_vf(j, k, l, b_idx%beg + dir_idx(2) - 1), &
17403 ql_prim_rsz_vf(j, k, l, b_idx%beg + dir_idx(3) - 1)]
17404 b%R = [qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + dir_idx(1) - 1), &
17405 qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + dir_idx(2) - 1), &
17406 qr_prim_rsz_vf(j + 1, k, l, b_idx%beg + dir_idx(3) - 1)]
17407 end if
17408 end if
17409
17410 ! Sum properties of all fluid components
17411 rho%L = 0._wp; gamma%L = 0._wp; pi_inf%L = 0._wp; qv%L = 0._wp
17412 rho%R = 0._wp; gamma%R = 0._wp; pi_inf%R = 0._wp; qv%R = 0._wp
17413
17414# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17415#if defined(MFC_OpenACC)
17416# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17417!$acc loop seq
17418# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17419#elif defined(MFC_OpenMP)
17420# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17421
17422# 3820 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17423#endif
17424 do i = 1, num_fluids
17425 rho%L = rho%L + alpha_rho_l(i)
17426 gamma%L = gamma%L + alpha_l(i)*gammas(i)
17427 pi_inf%L = pi_inf%L + alpha_l(i)*pi_infs(i)
17428 qv%L = qv%L + alpha_rho_l(i)*qvs(i)
17429
17430 rho%R = rho%R + alpha_rho_r(i)
17431 gamma%R = gamma%R + alpha_r(i)*gammas(i)
17432 pi_inf%R = pi_inf%R + alpha_r(i)*pi_infs(i)
17433 qv%R = qv%R + alpha_rho_r(i)*qvs(i)
17434 end do
17435
17436 pres_mag%L = 0.5_wp*sum(b%L**2._wp)
17437 pres_mag%R = 0.5_wp*sum(b%R**2._wp)
17438 e%L = gamma%L*pres%L + pi_inf%L + 0.5_wp*rho%L*vel_rms%L + qv%L + pres_mag%L
17439 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
17440 h_no_mag%L = (e%L + pres%L - pres_mag%L)/rho%L
17441 h_no_mag%R = (e%R + pres%R - pres_mag%R)/rho%R ! stagnation enthalpy here excludes magnetic energy (only used to find speed of sound)
17442
17443 ! (2) Compute fast wave speeds
17444 call s_compute_speed_of_sound(pres%L, rho%L, gamma%L, pi_inf%L, h_no_mag%L, alpha_l, vel_rms%L, 0._wp, c%L, qv%L)
17445 call s_compute_speed_of_sound(pres%R, rho%R, gamma%R, pi_inf%R, h_no_mag%R, alpha_r, vel_rms%R, 0._wp, c%R, qv%R)
17446 call s_compute_fast_magnetosonic_speed(rho%L, c%L, b%L, norm_dir, c_fast%L, h_no_mag%L)
17447 call s_compute_fast_magnetosonic_speed(rho%R, c%R, b%R, norm_dir, c_fast%R, h_no_mag%R)
17448
17449 ! (3) Compute contact speed s_M [Miyoshi Equ. (38)]
17450 s_l = min(vel%L(1) - c_fast%L, vel%R(1) - c_fast%R)
17451 s_r = max(vel%R(1) + c_fast%R, vel%L(1) + c_fast%L)
17452
17453 ptot_l = pres%L + pres_mag%L
17454 ptot_r = pres%R + pres_mag%R
17455
17456 s_m = (((s_r - vel%R(1))*rho%R*vel%R(1) - &
17457 (s_l - vel%L(1))*rho%L*vel%L(1) - ptot_r + ptot_l)/ &
17458 ((s_r - vel%R(1))*rho%R - (s_l - vel%L(1))*rho%L))
17459
17460 ! (4) Compute star state variables
17461 rhol_star = rho%L*(s_l - vel%L(1))/(s_l - s_m)
17462 rhor_star = rho%R*(s_r - vel%R(1))/(s_r - s_m)
17463 p_star = ptot_l + rho%L*(s_l - vel%L(1))*(s_m - vel%L(1))/(s_l - s_m)
17464 e_starl = ((s_l - vel%L(1))*e%L - ptot_l*vel%L(1) + p_star*s_m)/(s_l - s_m)
17465 e_starr = ((s_r - vel%R(1))*e%R - ptot_r*vel%R(1) + p_star*s_m)/(s_r - s_m)
17466
17467 ! (5) Compute left/right state vectors and fluxes
17468 u_l = [rho%L, rho%L*vel%L(1:3), b%L(2:3), e%L]
17469 u_starl = [rhol_star, rhol_star*s_m, rhol_star*vel%L(2:3), b%L(2:3), e_starl]
17470 u_r = [rho%R, rho%R*vel%R(1:3), b%R(2:3), e%R]
17471 u_starr = [rhor_star, rhor_star*s_m, rhor_star*vel%R(2:3), b%R(2:3), e_starr]
17472
17473 ! Compute the left/right fluxes
17474 f_l(1) = u_l(2)
17475 f_l(2) = u_l(2)*vel%L(1) - b%L(1)*b%L(1) + ptot_l
17476 f_l(3:4) = u_l(2)*vel%L(2:3) - b%L(1)*b%L(2:3)
17477 f_l(5:6) = vel%L(1)*b%L(2:3) - vel%L(2:3)*b%L(1)
17478 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))
17479
17480 f_r(1) = u_r(2)
17481 f_r(2) = u_r(2)*vel%R(1) - b%R(1)*b%R(1) + ptot_r
17482 f_r(3:4) = u_r(2)*vel%R(2:3) - b%R(1)*b%R(2:3)
17483 f_r(5:6) = vel%R(1)*b%R(2:3) - vel%R(2:3)*b%R(1)
17484 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))
17485 ! Compute the star flux using HLL relation
17486 f_starl = f_l + s_l*(u_starl - u_l)
17487 f_starr = f_r + s_r*(u_starr - u_r)
17488 ! Compute the rotational (Alfvén) speeds
17489 s_starl = s_m - abs(b%L(1))/sqrt(rhol_star)
17490 s_starr = s_m + abs(b%L(1))/sqrt(rhor_star)
17491 ! Compute the double–star states [Miyoshi Eqns. (59)-(62)]
17492 sqrt_rhol_star = sqrt(rhol_star); sqrt_rhor_star = sqrt(rhor_star)
17493 vl_star = vel%L(2); wl_star = vel%L(3)
17494 vr_star = vel%R(2); wr_star = vel%R(3)
17495
17496 ! (6) Compute the double–star states [Miyoshi Eqns. (59)-(62)]
17497 denom_ds = sqrt_rhol_star + sqrt_rhor_star
17498 sign_bx = sign(1._wp, b%L(1))
17499 v_double = (sqrt_rhol_star*vl_star + sqrt_rhor_star*vr_star + (b%R(2) - b%L(2))*sign_bx)/denom_ds
17500 w_double = (sqrt_rhol_star*wl_star + sqrt_rhor_star*wr_star + (b%R(3) - b%L(3))*sign_bx)/denom_ds
17501 by_double = (sqrt_rhol_star*b%R(2) + sqrt_rhor_star*b%L(2) + sqrt_rhol_star*sqrt_rhor_star*(vr_star - vl_star)*sign_bx)/denom_ds
17502 bz_double = (sqrt_rhol_star*b%R(3) + sqrt_rhor_star*b%L(3) + sqrt_rhol_star*sqrt_rhor_star*(wr_star - wl_star)*sign_bx)/denom_ds
17503
17504 e_doublel = e_starl - sqrt_rhol_star*((vl_star*b%L(2) + wl_star*b%L(3)) - (v_double*by_double + w_double*bz_double))*sign_bx
17505 e_doubler = e_starr + sqrt_rhor_star*((vr_star*b%R(2) + wr_star*b%R(3)) - (v_double*by_double + w_double*bz_double))*sign_bx
17506 e_double = 0.5_wp*(e_doublel + e_doubler)
17507
17508 u_doublel = [rhol_star, rhol_star*s_m, rhol_star*v_double, rhol_star*w_double, by_double, bz_double, e_double]
17509 u_doubler = [rhor_star, rhor_star*s_m, rhor_star*v_double, rhor_star*w_double, by_double, bz_double, e_double]
17510
17511 ! (11) Choose HLLD flux based on wave-speed regions
17512 if (0.0_wp <= s_l) then
17513 f_hlld = f_l
17514 else if (0.0_wp <= s_starl) then
17515 f_hlld = f_l + s_l*(u_starl - u_l)
17516 else if (0.0_wp <= s_m) then
17517 f_hlld = f_starl + s_starl*(u_doublel - u_starl)
17518 else if (0.0_wp <= s_starr) then
17519 f_hlld = f_starr + s_starr*(u_doubler - u_starr)
17520 else if (0.0_wp <= s_r) then
17521 f_hlld = f_r + s_r*(u_starr - u_r)
17522 else
17523 f_hlld = f_r
17524 end if
17525
17526 ! (12) Reorder and write temporary variables to the flux array
17527 ! Mass
17528 flux_rsz_vf(j, k, l, 1) = f_hlld(1) ! TODO multi-component
17529 ! Momentum
17530 flux_rsz_vf(j, k, l, contxe + dir_idx(1)) = f_hlld(2)
17531 flux_rsz_vf(j, k, l, contxe + dir_idx(2)) = f_hlld(3)
17532 flux_rsz_vf(j, k, l, contxe + dir_idx(3)) = f_hlld(4)
17533 ! Magnetic field
17534 if (n == 0) then
17535 flux_rsz_vf(j, k, l, b_idx%beg) = f_hlld(5)
17536 flux_rsz_vf(j, k, l, b_idx%beg + 1) = f_hlld(6)
17537 else
17538 flux_rsz_vf(j, k, l, b_idx%beg + dir_idx(2) - 1) = f_hlld(5)
17539 flux_rsz_vf(j, k, l, b_idx%beg + dir_idx(3) - 1) = f_hlld(6)
17540 end if
17541 ! Energy
17542 flux_rsz_vf(j, k, l, e_idx) = f_hlld(7)
17543 ! Partial fraction
17544
17545# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17546#if defined(MFC_OpenACC)
17547# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17548!$acc loop seq
17549# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17550#elif defined(MFC_OpenMP)
17551# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17552
17553# 3941 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17554#endif
17555 do i = advxb, advxe
17556 flux_rsz_vf(j, k, l, i) = 0._wp ! TODO multi-component (zero for now)
17557 end do
17558
17559 flux_src_rsz_vf(j, k, l, advxb) = 0._wp
17560 end do
17561 end do
17562 end do
17563
17564# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17565
17566# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17567#if defined(MFC_OpenACC)
17568# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17569!$acc end parallel loop
17570# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17571#elif defined(MFC_OpenMP)
17572# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17573
17574# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17575
17576# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17577!$omp end target teams loop
17578# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17579#endif
17580# 3950 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17581
17582 end if
17583# 3953 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17584
17585 call s_finalize_riemann_solver(flux_vf, flux_src_vf, flux_gsrc_vf, &
17586 norm_dir)
17587 end subroutine s_hlld_riemann_solver
17588
17589 !> The computation of parameters, the allocation of memory,
17590 !! the association of pointers and/or the execution of any
17591 !! other procedures that are necessary to setup the module.
17592 impure subroutine s_initialize_riemann_solvers_module
17593
17594 ! Allocating the variables that will be utilized to formulate the
17595 ! left, right, and average states of the Riemann problem, as well
17596 ! the Riemann problem solution
17597 integer :: i, j
17598
17599#ifdef MFC_DEBUG
17600# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17601 block
17602# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17603 use iso_fortran_env, only: output_unit
17604# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17605
17606# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17607 print *, 'm_riemann_solvers.fpp:3968: ', '@:ALLOCATE(Gs_rs(1:num_fluids))'
17608# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17609
17610# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17611 call flush (output_unit)
17612# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17613 end block
17614# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17615#endif
17616# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17617 allocate (gs_rs(1:num_fluids))
17618# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17619
17620# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17621
17622# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17623#if defined(MFC_OpenACC)
17624# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17625!$acc enter data create(Gs_rs)
17626# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17627#elif defined(MFC_OpenMP)
17628# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17629!$omp target enter data map(always,alloc:Gs_rs)
17630# 3968 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17631#endif
17632
17633 do i = 1, num_fluids
17634 gs_rs(i) = fluid_pp(i)%G
17635 end do
17636
17637# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17638#if defined(MFC_OpenACC)
17639# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17640!$acc update device(Gs_rs)
17641# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17642#elif defined(MFC_OpenMP)
17643# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17644!$omp target update to(Gs_rs)
17645# 3973 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17646#endif
17647
17648 if (viscous) then
17649#ifdef MFC_DEBUG
17650# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17651 block
17652# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17653 use iso_fortran_env, only: output_unit
17654# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17655
17656# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17657 print *, 'm_riemann_solvers.fpp:3976: ', '@:ALLOCATE(Res_gs(1:2, 1:Re_size_max))'
17658# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17659
17660# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17661 call flush (output_unit)
17662# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17663 end block
17664# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17665#endif
17666# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17667 allocate (res_gs(1:2, 1:re_size_max))
17668# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17669
17670# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17671
17672# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17673#if defined(MFC_OpenACC)
17674# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17675!$acc enter data create(Res_gs)
17676# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17677#elif defined(MFC_OpenMP)
17678# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17679!$omp target enter data map(always,alloc:Res_gs)
17680# 3976 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17681#endif
17682 end if
17683
17684 if (viscous) then
17685 do i = 1, 2
17686 do j = 1, re_size(i)
17687 res_gs(i, j) = fluid_pp(re_idx(i, j))%Re(i)
17688 end do
17689 end do
17690
17691# 3985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17692#if defined(MFC_OpenACC)
17693# 3985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17694!$acc update device(Res_gs, Re_idx, Re_size)
17695# 3985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17696#elif defined(MFC_OpenMP)
17697# 3985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17698!$omp target update to(Res_gs, Re_idx, Re_size)
17699# 3985 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17700#endif
17701 end if
17702
17703
17704# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17705#if defined(MFC_OpenACC)
17706# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17707!$acc enter data copyin(is1, is2, is3, isx, isy, isz)
17708# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17709#elif defined(MFC_OpenMP)
17710# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17711!$omp target enter data map(to:is1, is2, is3, isx, isy, isz)
17712# 3988 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17713#endif
17714
17715 is1%beg = -1; is2%beg = 0; is3%beg = 0
17716 is1%end = m; is2%end = n; is3%end = p
17717
17718#ifdef MFC_DEBUG
17719# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17720 block
17721# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17722 use iso_fortran_env, only: output_unit
17723# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17724
17725# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17726 print *, 'm_riemann_solvers.fpp:3993: ', '@:ALLOCATE(flux_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
17727# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17728
17729# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17730 call flush (output_unit)
17731# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17732 end block
17733# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17734#endif
17735# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17736 allocate (flux_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
17737# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17738
17739# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17740
17741# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17742#if defined(MFC_OpenACC)
17743# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17744!$acc enter data create(flux_rsx_vf)
17745# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17746#elif defined(MFC_OpenMP)
17747# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17748!$omp target enter data map(always,alloc:flux_rsx_vf)
17749# 3993 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17750#endif
17751# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17752#ifdef MFC_DEBUG
17753# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17754 block
17755# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17756 use iso_fortran_env, only: output_unit
17757# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17758
17759# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17760 print *, 'm_riemann_solvers.fpp:3996: ', '@:ALLOCATE(flux_gsrc_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
17761# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17762
17763# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17764 call flush (output_unit)
17765# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17766 end block
17767# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17768#endif
17769# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17770 allocate (flux_gsrc_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
17771# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17772
17773# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17774
17775# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17776#if defined(MFC_OpenACC)
17777# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17778!$acc enter data create(flux_gsrc_rsx_vf)
17779# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17780#elif defined(MFC_OpenMP)
17781# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17782!$omp target enter data map(always,alloc:flux_gsrc_rsx_vf)
17783# 3996 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17784#endif
17785# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17786#ifdef MFC_DEBUG
17787# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17788 block
17789# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17790 use iso_fortran_env, only: output_unit
17791# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17792
17793# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17794 print *, 'm_riemann_solvers.fpp:3999: ', '@:ALLOCATE(flux_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))'
17795# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17796
17797# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17798 call flush (output_unit)
17799# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17800 end block
17801# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17802#endif
17803# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17804 allocate (flux_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))
17805# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17806
17807# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17808
17809# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17810#if defined(MFC_OpenACC)
17811# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17812!$acc enter data create(flux_src_rsx_vf)
17813# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17814#elif defined(MFC_OpenMP)
17815# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17816!$omp target enter data map(always,alloc:flux_src_rsx_vf)
17817# 3999 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17818#endif
17819# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17820#ifdef MFC_DEBUG
17821# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17822 block
17823# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17824 use iso_fortran_env, only: output_unit
17825# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17826
17827# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17828 print *, 'm_riemann_solvers.fpp:4002: ', '@:ALLOCATE(vel_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))'
17829# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17830
17831# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17832 call flush (output_unit)
17833# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17834 end block
17835# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17836#endif
17837# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17838 allocate (vel_src_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))
17839# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17840
17841# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17842
17843# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17844#if defined(MFC_OpenACC)
17845# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17846!$acc enter data create(vel_src_rsx_vf)
17847# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17848#elif defined(MFC_OpenMP)
17849# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17850!$omp target enter data map(always,alloc:vel_src_rsx_vf)
17851# 4002 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17852#endif
17853# 4005 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17854 if (qbmm) then
17855#ifdef MFC_DEBUG
17856# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17857 block
17858# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17859 use iso_fortran_env, only: output_unit
17860# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17861
17862# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17863 print *, 'm_riemann_solvers.fpp:4006: ', '@:ALLOCATE(mom_sp_rsx_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))'
17864# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17865
17866# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17867 call flush (output_unit)
17868# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17869 end block
17870# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17871#endif
17872# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17873 allocate (mom_sp_rsx_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))
17874# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17875
17876# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17877
17878# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17879#if defined(MFC_OpenACC)
17880# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17881!$acc enter data create(mom_sp_rsx_vf)
17882# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17883#elif defined(MFC_OpenMP)
17884# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17885!$omp target enter data map(always,alloc:mom_sp_rsx_vf)
17886# 4006 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17887#endif
17888 end if
17889
17890 if (viscous) then
17891#ifdef MFC_DEBUG
17892# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17893 block
17894# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17895 use iso_fortran_env, only: output_unit
17896# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17897
17898# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17899 print *, 'm_riemann_solvers.fpp:4010: ', '@:ALLOCATE(Re_avg_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))'
17900# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17901
17902# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17903 call flush (output_unit)
17904# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17905 end block
17906# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17907#endif
17908# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17909 allocate (re_avg_rsx_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))
17910# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17911
17912# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17913
17914# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17915#if defined(MFC_OpenACC)
17916# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17917!$acc enter data create(Re_avg_rsx_vf)
17918# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17919#elif defined(MFC_OpenMP)
17920# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17921!$omp target enter data map(always,alloc:Re_avg_rsx_vf)
17922# 4010 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17923#endif
17924# 4013 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17925 end if
17926
17927 if (n == 0) return
17928
17929 is1%beg = -1; is2%beg = 0; is3%beg = 0
17930 is1%end = n; is2%end = m; is3%end = p
17931
17932#ifdef MFC_DEBUG
17933# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17934 block
17935# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17936 use iso_fortran_env, only: output_unit
17937# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17938
17939# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17940 print *, 'm_riemann_solvers.fpp:4020: ', '@:ALLOCATE(flux_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
17941# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17942
17943# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17944 call flush (output_unit)
17945# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17946 end block
17947# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17948#endif
17949# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17950 allocate (flux_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
17951# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17952
17953# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17954
17955# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17956#if defined(MFC_OpenACC)
17957# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17958!$acc enter data create(flux_rsy_vf)
17959# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17960#elif defined(MFC_OpenMP)
17961# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17962!$omp target enter data map(always,alloc:flux_rsy_vf)
17963# 4020 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17964#endif
17965# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17966#ifdef MFC_DEBUG
17967# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17968 block
17969# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17970 use iso_fortran_env, only: output_unit
17971# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17972
17973# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17974 print *, 'm_riemann_solvers.fpp:4023: ', '@:ALLOCATE(flux_gsrc_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
17975# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17976
17977# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17978 call flush (output_unit)
17979# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17980 end block
17981# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17982#endif
17983# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17984 allocate (flux_gsrc_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
17985# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17986
17987# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17988
17989# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17990#if defined(MFC_OpenACC)
17991# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17992!$acc enter data create(flux_gsrc_rsy_vf)
17993# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17994#elif defined(MFC_OpenMP)
17995# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17996!$omp target enter data map(always,alloc:flux_gsrc_rsy_vf)
17997# 4023 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
17998#endif
17999# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18000#ifdef MFC_DEBUG
18001# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18002 block
18003# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18004 use iso_fortran_env, only: output_unit
18005# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18006
18007# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18008 print *, 'm_riemann_solvers.fpp:4026: ', '@:ALLOCATE(flux_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))'
18009# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18010
18011# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18012 call flush (output_unit)
18013# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18014 end block
18015# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18016#endif
18017# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18018 allocate (flux_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))
18019# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18020
18021# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18022
18023# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18024#if defined(MFC_OpenACC)
18025# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18026!$acc enter data create(flux_src_rsy_vf)
18027# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18028#elif defined(MFC_OpenMP)
18029# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18030!$omp target enter data map(always,alloc:flux_src_rsy_vf)
18031# 4026 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18032#endif
18033# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18034#ifdef MFC_DEBUG
18035# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18036 block
18037# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18038 use iso_fortran_env, only: output_unit
18039# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18040
18041# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18042 print *, 'm_riemann_solvers.fpp:4029: ', '@:ALLOCATE(vel_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))'
18043# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18044
18045# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18046 call flush (output_unit)
18047# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18048 end block
18049# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18050#endif
18051# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18052 allocate (vel_src_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))
18053# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18054
18055# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18056
18057# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18058#if defined(MFC_OpenACC)
18059# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18060!$acc enter data create(vel_src_rsy_vf)
18061# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18062#elif defined(MFC_OpenMP)
18063# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18064!$omp target enter data map(always,alloc:vel_src_rsy_vf)
18065# 4029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18066#endif
18067# 4032 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18068
18069 if (qbmm) then
18070#ifdef MFC_DEBUG
18071# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18072 block
18073# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18074 use iso_fortran_env, only: output_unit
18075# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18076
18077# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18078 print *, 'm_riemann_solvers.fpp:4034: ', '@:ALLOCATE(mom_sp_rsy_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))'
18079# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18080
18081# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18082 call flush (output_unit)
18083# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18084 end block
18085# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18086#endif
18087# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18088 allocate (mom_sp_rsy_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))
18089# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18090
18091# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18092
18093# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18094#if defined(MFC_OpenACC)
18095# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18096!$acc enter data create(mom_sp_rsy_vf)
18097# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18098#elif defined(MFC_OpenMP)
18099# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18100!$omp target enter data map(always,alloc:mom_sp_rsy_vf)
18101# 4034 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18102#endif
18103 end if
18104
18105 if (viscous) then
18106#ifdef MFC_DEBUG
18107# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18108 block
18109# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18110 use iso_fortran_env, only: output_unit
18111# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18112
18113# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18114 print *, 'm_riemann_solvers.fpp:4038: ', '@:ALLOCATE(Re_avg_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))'
18115# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18116
18117# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18118 call flush (output_unit)
18119# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18120 end block
18121# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18122#endif
18123# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18124 allocate (re_avg_rsy_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))
18125# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18126
18127# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18128
18129# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18130#if defined(MFC_OpenACC)
18131# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18132!$acc enter data create(Re_avg_rsy_vf)
18133# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18134#elif defined(MFC_OpenMP)
18135# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18136!$omp target enter data map(always,alloc:Re_avg_rsy_vf)
18137# 4038 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18138#endif
18139# 4041 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18140 end if
18141
18142 if (p == 0) return
18143
18144 is1%beg = -1; is2%beg = 0; is3%beg = 0
18145 is1%end = p; is2%end = n; is3%end = m
18146
18147#ifdef MFC_DEBUG
18148# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18149 block
18150# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18151 use iso_fortran_env, only: output_unit
18152# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18153
18154# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18155 print *, 'm_riemann_solvers.fpp:4048: ', '@:ALLOCATE(flux_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
18156# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18157
18158# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18159 call flush (output_unit)
18160# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18161 end block
18162# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18163#endif
18164# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18165 allocate (flux_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
18166# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18167
18168# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18169
18170# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18171#if defined(MFC_OpenACC)
18172# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18173!$acc enter data create(flux_rsz_vf)
18174# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18175#elif defined(MFC_OpenMP)
18176# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18177!$omp target enter data map(always,alloc:flux_rsz_vf)
18178# 4048 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18179#endif
18180# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18181#ifdef MFC_DEBUG
18182# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18183 block
18184# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18185 use iso_fortran_env, only: output_unit
18186# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18187
18188# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18189 print *, 'm_riemann_solvers.fpp:4051: ', '@:ALLOCATE(flux_gsrc_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))'
18190# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18191
18192# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18193 call flush (output_unit)
18194# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18195 end block
18196# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18197#endif
18198# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18199 allocate (flux_gsrc_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:sys_size))
18200# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18201
18202# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18203
18204# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18205#if defined(MFC_OpenACC)
18206# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18207!$acc enter data create(flux_gsrc_rsz_vf)
18208# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18209#elif defined(MFC_OpenMP)
18210# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18211!$omp target enter data map(always,alloc:flux_gsrc_rsz_vf)
18212# 4051 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18213#endif
18214# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18215#ifdef MFC_DEBUG
18216# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18217 block
18218# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18219 use iso_fortran_env, only: output_unit
18220# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18221
18222# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18223 print *, 'm_riemann_solvers.fpp:4054: ', '@:ALLOCATE(flux_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))'
18224# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18225
18226# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18227 call flush (output_unit)
18228# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18229 end block
18230# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18231#endif
18232# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18233 allocate (flux_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, advxb:sys_size))
18234# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18235
18236# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18237
18238# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18239#if defined(MFC_OpenACC)
18240# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18241!$acc enter data create(flux_src_rsz_vf)
18242# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18243#elif defined(MFC_OpenMP)
18244# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18245!$omp target enter data map(always,alloc:flux_src_rsz_vf)
18246# 4054 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18247#endif
18248# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18249#ifdef MFC_DEBUG
18250# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18251 block
18252# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18253 use iso_fortran_env, only: output_unit
18254# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18255
18256# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18257 print *, 'm_riemann_solvers.fpp:4057: ', '@:ALLOCATE(vel_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))'
18258# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18259
18260# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18261 call flush (output_unit)
18262# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18263 end block
18264# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18265#endif
18266# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18267 allocate (vel_src_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:num_vels))
18268# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18269
18270# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18271
18272# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18273#if defined(MFC_OpenACC)
18274# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18275!$acc enter data create(vel_src_rsz_vf)
18276# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18277#elif defined(MFC_OpenMP)
18278# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18279!$omp target enter data map(always,alloc:vel_src_rsz_vf)
18280# 4057 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18281#endif
18282# 4060 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18283
18284 if (qbmm) then
18285#ifdef MFC_DEBUG
18286# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18287 block
18288# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18289 use iso_fortran_env, only: output_unit
18290# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18291
18292# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18293 print *, 'm_riemann_solvers.fpp:4062: ', '@:ALLOCATE(mom_sp_rsz_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))'
18294# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18295
18296# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18297 call flush (output_unit)
18298# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18299 end block
18300# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18301#endif
18302# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18303 allocate (mom_sp_rsz_vf(is1%beg:is1%end + 1, is2%beg:is2%end, is3%beg:is3%end, 1:4))
18304# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18305
18306# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18307
18308# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18309#if defined(MFC_OpenACC)
18310# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18311!$acc enter data create(mom_sp_rsz_vf)
18312# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18313#elif defined(MFC_OpenMP)
18314# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18315!$omp target enter data map(always,alloc:mom_sp_rsz_vf)
18316# 4062 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18317#endif
18318 end if
18319
18320 if (viscous) then
18321#ifdef MFC_DEBUG
18322# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18323 block
18324# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18325 use iso_fortran_env, only: output_unit
18326# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18327
18328# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18329 print *, 'm_riemann_solvers.fpp:4066: ', '@:ALLOCATE(Re_avg_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))'
18330# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18331
18332# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18333 call flush (output_unit)
18334# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18335 end block
18336# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18337#endif
18338# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18339 allocate (re_avg_rsz_vf(is1%beg:is1%end, is2%beg:is2%end, is3%beg:is3%end, 1:2))
18340# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18341
18342# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18343
18344# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18345#if defined(MFC_OpenACC)
18346# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18347!$acc enter data create(Re_avg_rsz_vf)
18348# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18349#elif defined(MFC_OpenMP)
18350# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18351!$omp target enter data map(always,alloc:Re_avg_rsz_vf)
18352# 4066 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18353#endif
18354# 4069 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18355 end if
18356
18357 end subroutine s_initialize_riemann_solvers_module
18358
18359 !> The purpose of this subroutine is to populate the buffers
18360 !! of the left and right Riemann states variables, depending
18361 !! on the boundary conditions.
18362 !! @param qL_prim_rsx_vf Left WENO-reconstructed cell-boundary values (x-dir)
18363 !! @param qL_prim_rsy_vf Left WENO-reconstructed cell-boundary values (y-dir)
18364 !! @param qL_prim_rsz_vf Left WENO-reconstructed cell-boundary values (z-dir)
18365 !! @param dqL_prim_dx_vf The left WENO-reconstructed cell-boundary values of the
18366 !! first-order x-dir spatial derivatives
18367 !! @param dqL_prim_dy_vf The left WENO-reconstructed cell-boundary values of the
18368 !! first-order y-dir spatial derivatives
18369 !! @param dqL_prim_dz_vf The left WENO-reconstructed cell-boundary values of the
18370 !! first-order z-dir spatial derivatives
18371 !! @param qR_prim_rsx_vf Right WENO-reconstructed cell-boundary values (x-dir)
18372 !! @param qR_prim_rsy_vf Right WENO-reconstructed cell-boundary values (y-dir)
18373 !! @param qR_prim_rsz_vf Right WENO-reconstructed cell-boundary values (z-dir)
18374 !! @param dqR_prim_dx_vf The right WENO-reconstructed cell-boundary values of the
18375 !! first-order x-dir spatial derivatives
18376 !! @param dqR_prim_dy_vf The right WENO-reconstructed cell-boundary values of the
18377 !! first-order y-dir spatial derivatives
18378 !! @param dqR_prim_dz_vf The right WENO-reconstructed cell-boundary values of the
18379 !! first-order z-dir spatial derivatives
18380 !! @param norm_dir Dir. splitting direction
18381 !! @param ix Index bounds in the x-dir
18382 !! @param iy Index bounds in the y-dir
18383 !! @param iz Index bounds in the z-dir
18384 subroutine s_populate_riemann_states_variables_buffers( &
18385 qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, dqL_prim_dx_vf, &
18386 dqL_prim_dy_vf, &
18387 dqL_prim_dz_vf, &
18388 qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf, dqR_prim_dx_vf, &
18389 dqR_prim_dy_vf, &
18390 dqR_prim_dz_vf, &
18391 norm_dir, ix, iy, iz)
18392
18393 real(wp), dimension(idwbuff(1)%beg:, idwbuff(2)%beg:, idwbuff(3)%beg:, 1:), intent(inout) :: qL_prim_rsx_vf, qL_prim_rsy_vf, qL_prim_rsz_vf, qR_prim_rsx_vf, qR_prim_rsy_vf, qR_prim_rsz_vf
18394
18395 type(scalar_field), &
18396 allocatable, dimension(:), &
18397 intent(inout) :: dqL_prim_dx_vf, dqR_prim_dx_vf, &
18398 dqL_prim_dy_vf, dqR_prim_dy_vf, &
18399 dqL_prim_dz_vf, dqR_prim_dz_vf
18400
18401 integer, intent(in) :: norm_dir
18402 type(int_bounds_info), intent(in) :: ix, iy, iz
18403
18404 integer :: i, j, k, l !< Generic loop iterator
18405
18406 if (norm_dir == 1) then
18407 is1 = ix; is2 = iy; is3 = iz
18408 dir_idx = (/1, 2, 3/); dir_flg = (/1._wp, 0._wp, 0._wp/)
18409 elseif (norm_dir == 2) then
18410 is1 = iy; is2 = ix; is3 = iz
18411 dir_idx = (/2, 1, 3/); dir_flg = (/0._wp, 1._wp, 0._wp/)
18412 else
18413 is1 = iz; is2 = iy; is3 = ix
18414 dir_idx = (/3, 1, 2/); dir_flg = (/0._wp, 0._wp, 1._wp/)
18415 end if
18416
18417
18418# 4131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18419#if defined(MFC_OpenACC)
18420# 4131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18421!$acc update device(is1, is2, is3)
18422# 4131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18423#elif defined(MFC_OpenMP)
18424# 4131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18425!$omp target update to(is1, is2, is3)
18426# 4131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18427#endif
18428
18429 if (elasticity) then
18430 if (norm_dir == 1) then
18431 dir_idx_tau = (/1, 2, 4/)
18432 else if (norm_dir == 2) then
18433 dir_idx_tau = (/3, 2, 5/)
18434 else
18435 dir_idx_tau = (/6, 4, 5/)
18436 end if
18437 end if
18438
18439 isx = ix; isy = iy; isz = iz
18440 ! for stuff in the same module
18441
18442# 4145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18443#if defined(MFC_OpenACC)
18444# 4145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18445!$acc update device(isx, isy, isz)
18446# 4145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18447#elif defined(MFC_OpenMP)
18448# 4145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18449!$omp target update to(isx, isy, isz)
18450# 4145 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18451#endif
18452 ! for stuff in different modules
18453
18454# 4147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18455#if defined(MFC_OpenACC)
18456# 4147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18457!$acc update device(dir_idx, dir_flg, dir_idx_tau)
18458# 4147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18459#elif defined(MFC_OpenMP)
18460# 4147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18461!$omp target update to(dir_idx, dir_flg, dir_idx_tau)
18462# 4147 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18463#endif
18464
18465 ! Population of Buffers in x-direction
18466 if (norm_dir == 1) then
18467
18468 if (bc_x%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
18469
18470# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18471
18472# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18473#if defined(MFC_OpenACC)
18474# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18475!$acc parallel loop collapse(3) gang vector default(present)
18476# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18477#elif defined(MFC_OpenMP)
18478# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18479
18480# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18481
18482# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18483
18484# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18485!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18486# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18487#endif
18488# 4153 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18489
18490 do i = 1, sys_size
18491 do l = is3%beg, is3%end
18492 do k = is2%beg, is2%end
18493 ql_prim_rsx_vf(-1, k, l, i) = &
18494 qr_prim_rsx_vf(0, k, l, i)
18495 end do
18496 end do
18497 end do
18498
18499# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18500
18501# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18502#if defined(MFC_OpenACC)
18503# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18504!$acc end parallel loop
18505# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18506#elif defined(MFC_OpenMP)
18507# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18508
18509# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18510
18511# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18512!$omp end target teams loop
18513# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18514#endif
18515# 4162 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18516
18517
18518 if (viscous .or. dummy) then
18519
18520# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18521
18522# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18523#if defined(MFC_OpenACC)
18524# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18525!$acc parallel loop collapse(3) gang vector default(present)
18526# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18527#elif defined(MFC_OpenMP)
18528# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18529
18530# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18531
18532# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18533
18534# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18535!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18536# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18537#endif
18538# 4165 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18539
18540 do i = momxb, momxe
18541 do l = isz%beg, isz%end
18542 do k = isy%beg, isy%end
18543
18544 dql_prim_dx_vf(i)%sf(-1, k, l) = &
18545 dqr_prim_dx_vf(i)%sf(0, k, l)
18546 end do
18547 end do
18548 end do
18549
18550# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18551
18552# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18553#if defined(MFC_OpenACC)
18554# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18555!$acc end parallel loop
18556# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18557#elif defined(MFC_OpenMP)
18558# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18559
18560# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18561
18562# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18563!$omp end target teams loop
18564# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18565#endif
18566# 4175 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18567
18568
18569 if (n > 0) then
18570
18571# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18572
18573# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18574#if defined(MFC_OpenACC)
18575# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18576!$acc parallel loop collapse(3) gang vector default(present)
18577# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18578#elif defined(MFC_OpenMP)
18579# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18580
18581# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18582
18583# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18584
18585# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18586!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18587# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18588#endif
18589# 4178 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18590
18591 do i = momxb, momxe
18592 do l = isz%beg, isz%end
18593 do k = isy%beg, isy%end
18594
18595 dql_prim_dy_vf(i)%sf(-1, k, l) = &
18596 dqr_prim_dy_vf(i)%sf(0, k, l)
18597 end do
18598 end do
18599 end do
18600
18601# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18602
18603# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18604#if defined(MFC_OpenACC)
18605# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18606!$acc end parallel loop
18607# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18608#elif defined(MFC_OpenMP)
18609# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18610
18611# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18612
18613# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18614!$omp end target teams loop
18615# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18616#endif
18617# 4188 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18618
18619
18620 if (p > 0) then
18621
18622# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18623
18624# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18625#if defined(MFC_OpenACC)
18626# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18627!$acc parallel loop collapse(3) gang vector default(present)
18628# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18629#elif defined(MFC_OpenMP)
18630# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18631
18632# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18633
18634# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18635
18636# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18637!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18638# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18639#endif
18640# 4191 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18641
18642 do i = momxb, momxe
18643 do l = isz%beg, isz%end
18644 do k = isy%beg, isy%end
18645
18646 dql_prim_dz_vf(i)%sf(-1, k, l) = &
18647 dqr_prim_dz_vf(i)%sf(0, k, l)
18648 end do
18649 end do
18650 end do
18651
18652# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18653
18654# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18655#if defined(MFC_OpenACC)
18656# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18657!$acc end parallel loop
18658# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18659#elif defined(MFC_OpenMP)
18660# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18661
18662# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18663
18664# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18665!$omp end target teams loop
18666# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18667#endif
18668# 4201 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18669
18670 end if
18671
18672 end if
18673
18674 end if
18675
18676 end if
18677
18678 if (bc_x%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
18679
18680
18681# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18682
18683# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18684#if defined(MFC_OpenACC)
18685# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18686!$acc parallel loop collapse(3) gang vector default(present)
18687# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18688#elif defined(MFC_OpenMP)
18689# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18690
18691# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18692
18693# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18694
18695# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18696!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18697# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18698#endif
18699# 4212 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18700
18701 do i = 1, sys_size
18702 do l = is3%beg, is3%end
18703 do k = is2%beg, is2%end
18704 qr_prim_rsx_vf(m + 1, k, l, i) = &
18705 ql_prim_rsx_vf(m, k, l, i)
18706 end do
18707 end do
18708 end do
18709
18710# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18711
18712# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18713#if defined(MFC_OpenACC)
18714# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18715!$acc end parallel loop
18716# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18717#elif defined(MFC_OpenMP)
18718# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18719
18720# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18721
18722# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18723!$omp end target teams loop
18724# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18725#endif
18726# 4221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18727
18728
18729 if (viscous .or. dummy) then
18730
18731
18732# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18733
18734# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18735#if defined(MFC_OpenACC)
18736# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18737!$acc parallel loop collapse(3) gang vector default(present)
18738# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18739#elif defined(MFC_OpenMP)
18740# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18741
18742# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18743
18744# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18745
18746# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18747!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18748# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18749#endif
18750# 4225 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18751
18752 do i = momxb, momxe
18753 do l = isz%beg, isz%end
18754 do k = isy%beg, isy%end
18755
18756 dqr_prim_dx_vf(i)%sf(m + 1, k, l) = &
18757 dql_prim_dx_vf(i)%sf(m, k, l)
18758 end do
18759 end do
18760 end do
18761
18762# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18763
18764# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18765#if defined(MFC_OpenACC)
18766# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18767!$acc end parallel loop
18768# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18769#elif defined(MFC_OpenMP)
18770# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18771
18772# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18773
18774# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18775!$omp end target teams loop
18776# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18777#endif
18778# 4235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18779
18780
18781 if (n > 0) then
18782
18783# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18784
18785# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18786#if defined(MFC_OpenACC)
18787# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18788!$acc parallel loop collapse(3) gang vector default(present)
18789# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18790#elif defined(MFC_OpenMP)
18791# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18792
18793# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18794
18795# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18796
18797# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18798!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18799# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18800#endif
18801# 4238 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18802
18803 do i = momxb, momxe
18804 do l = isz%beg, isz%end
18805 do k = isy%beg, isy%end
18806
18807 dqr_prim_dy_vf(i)%sf(m + 1, k, l) = &
18808 dql_prim_dy_vf(i)%sf(m, k, l)
18809 end do
18810 end do
18811 end do
18812
18813# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18814
18815# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18816#if defined(MFC_OpenACC)
18817# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18818!$acc end parallel loop
18819# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18820#elif defined(MFC_OpenMP)
18821# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18822
18823# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18824
18825# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18826!$omp end target teams loop
18827# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18828#endif
18829# 4248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18830
18831
18832 if (p > 0) then
18833
18834# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18835
18836# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18837#if defined(MFC_OpenACC)
18838# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18839!$acc parallel loop collapse(3) gang vector default(present)
18840# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18841#elif defined(MFC_OpenMP)
18842# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18843
18844# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18845
18846# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18847
18848# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18849!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18850# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18851#endif
18852# 4251 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18853
18854 do i = momxb, momxe
18855 do l = isz%beg, isz%end
18856 do k = isy%beg, isy%end
18857
18858 dqr_prim_dz_vf(i)%sf(m + 1, k, l) = &
18859 dql_prim_dz_vf(i)%sf(m, k, l)
18860 end do
18861 end do
18862 end do
18863
18864# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18865
18866# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18867#if defined(MFC_OpenACC)
18868# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18869!$acc end parallel loop
18870# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18871#elif defined(MFC_OpenMP)
18872# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18873
18874# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18875
18876# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18877!$omp end target teams loop
18878# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18879#endif
18880# 4261 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18881
18882 end if
18883
18884 end if
18885
18886 end if
18887
18888 end if
18889 ! END: Population of Buffers in x-direction
18890
18891 ! Population of Buffers in y-direction
18892 elseif (norm_dir == 2) then
18893
18894 if (bc_y%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
18895
18896# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18897
18898# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18899#if defined(MFC_OpenACC)
18900# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18901!$acc parallel loop collapse(3) gang vector default(present)
18902# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18903#elif defined(MFC_OpenMP)
18904# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18905
18906# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18907
18908# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18909
18910# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18911!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18912# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18913#endif
18914# 4275 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18915
18916 do i = 1, sys_size
18917 do l = is3%beg, is3%end
18918 do k = is2%beg, is2%end
18919 ql_prim_rsy_vf(-1, k, l, i) = &
18920 qr_prim_rsy_vf(0, k, l, i)
18921 end do
18922 end do
18923 end do
18924
18925# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18926
18927# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18928#if defined(MFC_OpenACC)
18929# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18930!$acc end parallel loop
18931# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18932#elif defined(MFC_OpenMP)
18933# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18934
18935# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18936
18937# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18938!$omp end target teams loop
18939# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18940#endif
18941# 4284 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18942
18943
18944 if (viscous .or. dummy) then
18945
18946
18947# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18948
18949# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18950#if defined(MFC_OpenACC)
18951# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18952!$acc parallel loop collapse(3) gang vector default(present)
18953# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18954#elif defined(MFC_OpenMP)
18955# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18956
18957# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18958
18959# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18960
18961# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18962!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
18963# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18964#endif
18965# 4288 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18966
18967 do i = momxb, momxe
18968 do l = isz%beg, isz%end
18969 do j = isx%beg, isx%end
18970 dql_prim_dx_vf(i)%sf(j, -1, l) = &
18971 dqr_prim_dx_vf(i)%sf(j, 0, l)
18972 end do
18973 end do
18974 end do
18975
18976# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18977
18978# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18979#if defined(MFC_OpenACC)
18980# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18981!$acc end parallel loop
18982# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18983#elif defined(MFC_OpenMP)
18984# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18985
18986# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18987
18988# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18989!$omp end target teams loop
18990# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18991#endif
18992# 4297 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18993
18994
18995
18996# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18997
18998# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
18999#if defined(MFC_OpenACC)
19000# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19001!$acc parallel loop collapse(3) gang vector default(present)
19002# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19003#elif defined(MFC_OpenMP)
19004# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19005
19006# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19007
19008# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19009
19010# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19011!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19012# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19013#endif
19014# 4299 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19015
19016 do i = momxb, momxe
19017 do l = isz%beg, isz%end
19018 do j = isx%beg, isx%end
19019 dql_prim_dy_vf(i)%sf(j, -1, l) = &
19020 dqr_prim_dy_vf(i)%sf(j, 0, l)
19021 end do
19022 end do
19023 end do
19024
19025# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19026
19027# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19028#if defined(MFC_OpenACC)
19029# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19030!$acc end parallel loop
19031# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19032#elif defined(MFC_OpenMP)
19033# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19034
19035# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19036
19037# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19038!$omp end target teams loop
19039# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19040#endif
19041# 4308 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19042
19043
19044 if (p > 0) then
19045
19046# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19047
19048# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19049#if defined(MFC_OpenACC)
19050# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19051!$acc parallel loop collapse(3) gang vector default(present)
19052# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19053#elif defined(MFC_OpenMP)
19054# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19055
19056# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19057
19058# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19059
19060# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19061!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19062# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19063#endif
19064# 4311 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19065
19066 do i = momxb, momxe
19067 do l = isz%beg, isz%end
19068 do j = isx%beg, isx%end
19069 dql_prim_dz_vf(i)%sf(j, -1, l) = &
19070 dqr_prim_dz_vf(i)%sf(j, 0, l)
19071 end do
19072 end do
19073 end do
19074
19075# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19076
19077# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19078#if defined(MFC_OpenACC)
19079# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19080!$acc end parallel loop
19081# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19082#elif defined(MFC_OpenMP)
19083# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19084
19085# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19086
19087# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19088!$omp end target teams loop
19089# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19090#endif
19091# 4320 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19092
19093 end if
19094
19095 end if
19096
19097 end if
19098
19099 if (bc_y%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
19100
19101
19102# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19103
19104# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19105#if defined(MFC_OpenACC)
19106# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19107!$acc parallel loop collapse(3) gang vector default(present)
19108# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19109#elif defined(MFC_OpenMP)
19110# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19111
19112# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19113
19114# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19115
19116# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19117!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19118# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19119#endif
19120# 4329 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19121
19122 do i = 1, sys_size
19123 do l = is3%beg, is3%end
19124 do k = is2%beg, is2%end
19125 qr_prim_rsy_vf(n + 1, k, l, i) = &
19126 ql_prim_rsy_vf(n, k, l, i)
19127 end do
19128 end do
19129 end do
19130
19131# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19132
19133# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19134#if defined(MFC_OpenACC)
19135# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19136!$acc end parallel loop
19137# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19138#elif defined(MFC_OpenMP)
19139# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19140
19141# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19142
19143# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19144!$omp end target teams loop
19145# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19146#endif
19147# 4338 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19148
19149
19150 if (viscous .or. dummy) then
19151
19152
19153# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19154
19155# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19156#if defined(MFC_OpenACC)
19157# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19158!$acc parallel loop collapse(3) gang vector default(present)
19159# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19160#elif defined(MFC_OpenMP)
19161# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19162
19163# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19164
19165# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19166
19167# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19168!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19169# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19170#endif
19171# 4342 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19172
19173 do i = momxb, momxe
19174 do l = isz%beg, isz%end
19175 do j = isx%beg, isx%end
19176 dqr_prim_dx_vf(i)%sf(j, n + 1, l) = &
19177 dql_prim_dx_vf(i)%sf(j, n, l)
19178 end do
19179 end do
19180 end do
19181
19182# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19183
19184# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19185#if defined(MFC_OpenACC)
19186# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19187!$acc end parallel loop
19188# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19189#elif defined(MFC_OpenMP)
19190# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19191
19192# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19193
19194# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19195!$omp end target teams loop
19196# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19197#endif
19198# 4351 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19199
19200
19201
19202# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19203
19204# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19205#if defined(MFC_OpenACC)
19206# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19207!$acc parallel loop collapse(3) gang vector default(present)
19208# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19209#elif defined(MFC_OpenMP)
19210# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19211
19212# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19213
19214# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19215
19216# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19217!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19218# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19219#endif
19220# 4353 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19221
19222 do i = momxb, momxe
19223 do l = isz%beg, isz%end
19224 do j = isx%beg, isx%end
19225 dqr_prim_dy_vf(i)%sf(j, n + 1, l) = &
19226 dql_prim_dy_vf(i)%sf(j, n, l)
19227 end do
19228 end do
19229 end do
19230
19231# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19232
19233# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19234#if defined(MFC_OpenACC)
19235# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19236!$acc end parallel loop
19237# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19238#elif defined(MFC_OpenMP)
19239# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19240
19241# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19242
19243# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19244!$omp end target teams loop
19245# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19246#endif
19247# 4362 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19248
19249
19250 if (p > 0) then
19251
19252# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19253
19254# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19255#if defined(MFC_OpenACC)
19256# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19257!$acc parallel loop collapse(3) gang vector default(present)
19258# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19259#elif defined(MFC_OpenMP)
19260# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19261
19262# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19263
19264# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19265
19266# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19267!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19268# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19269#endif
19270# 4365 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19271
19272 do i = momxb, momxe
19273 do l = isz%beg, isz%end
19274 do j = isx%beg, isx%end
19275 dqr_prim_dz_vf(i)%sf(j, n + 1, l) = &
19276 dql_prim_dz_vf(i)%sf(j, n, l)
19277 end do
19278 end do
19279 end do
19280
19281# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19282
19283# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19284#if defined(MFC_OpenACC)
19285# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19286!$acc end parallel loop
19287# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19288#elif defined(MFC_OpenMP)
19289# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19290
19291# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19292
19293# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19294!$omp end target teams loop
19295# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19296#endif
19297# 4374 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19298
19299 end if
19300
19301 end if
19302
19303 end if
19304 ! END: Population of Buffers in y-direction
19305
19306 ! Population of Buffers in z-direction
19307 else
19308
19309 if (bc_z%beg == bc_riemann_extrap) then ! Riemann state extrap. BC at beginning
19310
19311# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19312
19313# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19314#if defined(MFC_OpenACC)
19315# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19316!$acc parallel loop collapse(3) gang vector default(present)
19317# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19318#elif defined(MFC_OpenMP)
19319# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19320
19321# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19322
19323# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19324
19325# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19326!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19327# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19328#endif
19329# 4386 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19330
19331 do i = 1, sys_size
19332 do l = is3%beg, is3%end
19333 do k = is2%beg, is2%end
19334 ql_prim_rsz_vf(-1, k, l, i) = &
19335 qr_prim_rsz_vf(0, k, l, i)
19336 end do
19337 end do
19338 end do
19339
19340# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19341
19342# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19343#if defined(MFC_OpenACC)
19344# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19345!$acc end parallel loop
19346# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19347#elif defined(MFC_OpenMP)
19348# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19349
19350# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19351
19352# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19353!$omp end target teams loop
19354# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19355#endif
19356# 4395 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19357
19358
19359 if (viscous .or. dummy) then
19360
19361# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19362
19363# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19364#if defined(MFC_OpenACC)
19365# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19366!$acc parallel loop collapse(3) gang vector default(present)
19367# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19368#elif defined(MFC_OpenMP)
19369# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19370
19371# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19372
19373# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19374
19375# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19376!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19377# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19378#endif
19379# 4398 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19380
19381 do i = momxb, momxe
19382 do k = isy%beg, isy%end
19383 do j = isx%beg, isx%end
19384 dql_prim_dx_vf(i)%sf(j, k, -1) = &
19385 dqr_prim_dx_vf(i)%sf(j, k, 0)
19386 end do
19387 end do
19388 end do
19389
19390# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19391
19392# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19393#if defined(MFC_OpenACC)
19394# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19395!$acc end parallel loop
19396# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19397#elif defined(MFC_OpenMP)
19398# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19399
19400# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19401
19402# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19403!$omp end target teams loop
19404# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19405#endif
19406# 4407 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19407
19408
19409# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19410
19411# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19412#if defined(MFC_OpenACC)
19413# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19414!$acc parallel loop collapse(3) gang vector default(present)
19415# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19416#elif defined(MFC_OpenMP)
19417# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19418
19419# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19420
19421# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19422
19423# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19424!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19425# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19426#endif
19427# 4408 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19428
19429 do i = momxb, momxe
19430 do k = isy%beg, isy%end
19431 do j = isx%beg, isx%end
19432 dql_prim_dy_vf(i)%sf(j, k, -1) = &
19433 dqr_prim_dy_vf(i)%sf(j, k, 0)
19434 end do
19435 end do
19436 end do
19437
19438# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19439
19440# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19441#if defined(MFC_OpenACC)
19442# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19443!$acc end parallel loop
19444# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19445#elif defined(MFC_OpenMP)
19446# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19447
19448# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19449
19450# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19451!$omp end target teams loop
19452# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19453#endif
19454# 4417 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19455
19456
19457# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19458
19459# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19460#if defined(MFC_OpenACC)
19461# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19462!$acc parallel loop collapse(3) gang vector default(present)
19463# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19464#elif defined(MFC_OpenMP)
19465# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19466
19467# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19468
19469# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19470
19471# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19472!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19473# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19474#endif
19475# 4418 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19476
19477 do i = momxb, momxe
19478 do k = isy%beg, isy%end
19479 do j = isx%beg, isx%end
19480 dql_prim_dz_vf(i)%sf(j, k, -1) = &
19481 dqr_prim_dz_vf(i)%sf(j, k, 0)
19482 end do
19483 end do
19484 end do
19485
19486# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19487
19488# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19489#if defined(MFC_OpenACC)
19490# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19491!$acc end parallel loop
19492# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19493#elif defined(MFC_OpenMP)
19494# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19495
19496# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19497
19498# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19499!$omp end target teams loop
19500# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19501#endif
19502# 4427 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19503
19504 end if
19505
19506 end if
19507
19508 if (bc_z%end == bc_riemann_extrap) then ! Riemann state extrap. BC at end
19509
19510
19511# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19512
19513# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19514#if defined(MFC_OpenACC)
19515# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19516!$acc parallel loop collapse(3) gang vector default(present)
19517# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19518#elif defined(MFC_OpenMP)
19519# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19520
19521# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19522
19523# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19524
19525# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19526!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19527# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19528#endif
19529# 4434 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19530
19531 do i = 1, sys_size
19532 do l = is3%beg, is3%end
19533 do k = is2%beg, is2%end
19534 qr_prim_rsz_vf(p + 1, k, l, i) = &
19535 ql_prim_rsz_vf(p, k, l, i)
19536 end do
19537 end do
19538 end do
19539
19540# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19541
19542# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19543#if defined(MFC_OpenACC)
19544# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19545!$acc end parallel loop
19546# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19547#elif defined(MFC_OpenMP)
19548# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19549
19550# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19551
19552# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19553!$omp end target teams loop
19554# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19555#endif
19556# 4443 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19557
19558
19559 if (viscous .or. dummy) then
19560
19561# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19562
19563# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19564#if defined(MFC_OpenACC)
19565# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19566!$acc parallel loop collapse(3) gang vector default(present)
19567# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19568#elif defined(MFC_OpenMP)
19569# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19570
19571# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19572
19573# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19574
19575# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19576!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19577# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19578#endif
19579# 4446 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19580
19581 do i = momxb, momxe
19582 do k = isy%beg, isy%end
19583 do j = isx%beg, isx%end
19584 dqr_prim_dx_vf(i)%sf(j, k, p + 1) = &
19585 dql_prim_dx_vf(i)%sf(j, k, p)
19586 end do
19587 end do
19588 end do
19589
19590# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19591
19592# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19593#if defined(MFC_OpenACC)
19594# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19595!$acc end parallel loop
19596# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19597#elif defined(MFC_OpenMP)
19598# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19599
19600# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19601
19602# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19603!$omp end target teams loop
19604# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19605#endif
19606# 4455 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19607
19608
19609
19610# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19611
19612# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19613#if defined(MFC_OpenACC)
19614# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19615!$acc parallel loop collapse(3) gang vector default(present)
19616# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19617#elif defined(MFC_OpenMP)
19618# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19619
19620# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19621
19622# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19623
19624# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19625!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19626# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19627#endif
19628# 4457 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19629
19630 do i = momxb, momxe
19631 do k = isy%beg, isy%end
19632 do j = isx%beg, isx%end
19633 dqr_prim_dy_vf(i)%sf(j, k, p + 1) = &
19634 dql_prim_dy_vf(i)%sf(j, k, p)
19635 end do
19636 end do
19637 end do
19638
19639# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19640
19641# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19642#if defined(MFC_OpenACC)
19643# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19644!$acc end parallel loop
19645# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19646#elif defined(MFC_OpenMP)
19647# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19648
19649# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19650
19651# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19652!$omp end target teams loop
19653# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19654#endif
19655# 4466 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19656
19657
19658
19659# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19660
19661# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19662#if defined(MFC_OpenACC)
19663# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19664!$acc parallel loop collapse(3) gang vector default(present)
19665# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19666#elif defined(MFC_OpenMP)
19667# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19668
19669# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19670
19671# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19672
19673# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19674!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19675# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19676#endif
19677# 4468 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19678
19679 do i = momxb, momxe
19680 do k = isy%beg, isy%end
19681 do j = isx%beg, isx%end
19682 dqr_prim_dz_vf(i)%sf(j, k, p + 1) = &
19683 dql_prim_dz_vf(i)%sf(j, k, p)
19684 end do
19685 end do
19686 end do
19687
19688# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19689
19690# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19691#if defined(MFC_OpenACC)
19692# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19693!$acc end parallel loop
19694# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19695#elif defined(MFC_OpenMP)
19696# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19697
19698# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19699
19700# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19701!$omp end target teams loop
19702# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19703#endif
19704# 4477 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19705
19706 end if
19707
19708 end if
19709
19710 end if
19711 ! END: Population of Buffers in z-direction
19712
19713 end subroutine s_populate_riemann_states_variables_buffers
19714
19715 !> The computation of parameters, the allocation of memory,
19716 !! the association of pointers and/or the execution of any
19717 !! other procedures needed to configure the chosen Riemann
19718 !! solver algorithm.
19719 !! @param flux_src_vf Intra-cell fluxes sources
19720 !! @param norm_dir Dir. splitting direction
19721 subroutine s_initialize_riemann_solver( &
19722 flux_src_vf, &
19723 norm_dir)
19724
19725 type(scalar_field), &
19726 dimension(sys_size), &
19727 intent(inout) :: flux_src_vf
19728
19729 integer, intent(in) :: norm_dir
19730
19731 integer :: i, j, k, l ! Generic loop iterators
19732
19733 ! Reshaping Inputted Data in x-direction
19734
19735 if (norm_dir == 1) then
19736
19737 if (viscous .or. (surface_tension) .or. dummy) then
19738
19739
19740# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19741
19742# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19743#if defined(MFC_OpenACC)
19744# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19745!$acc parallel loop collapse(4) gang vector default(present)
19746# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19747#elif defined(MFC_OpenMP)
19748# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19749
19750# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19751
19752# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19753
19754# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19755!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19756# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19757#endif
19758# 4511 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19759
19760 do i = momxb, e_idx
19761 do l = is3%beg, is3%end
19762 do k = is2%beg, is2%end
19763 do j = is1%beg, is1%end
19764 flux_src_vf(i)%sf(j, k, l) = 0._wp
19765 end do
19766 end do
19767 end do
19768 end do
19769
19770# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19771
19772# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19773#if defined(MFC_OpenACC)
19774# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19775!$acc end parallel loop
19776# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19777#elif defined(MFC_OpenMP)
19778# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19779
19780# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19781
19782# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19783!$omp end target teams loop
19784# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19785#endif
19786# 4521 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19787
19788 end if
19789
19790 if (chem_params%diffusion) then
19791
19792# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19793
19794# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19795#if defined(MFC_OpenACC)
19796# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19797!$acc parallel loop collapse(4) gang vector default(present)
19798# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19799#elif defined(MFC_OpenMP)
19800# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19801
19802# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19803
19804# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19805
19806# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19807!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19808# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19809#endif
19810# 4525 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19811
19812 do i = e_idx, chemxe
19813 do l = is3%beg, is3%end
19814 do k = is2%beg, is2%end
19815 do j = is1%beg, is1%end
19816 if (i == e_idx .or. i >= chemxb) then
19817 flux_src_vf(i)%sf(j, k, l) = 0._wp
19818 end if
19819 end do
19820 end do
19821 end do
19822 end do
19823
19824# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19825
19826# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19827#if defined(MFC_OpenACC)
19828# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19829!$acc end parallel loop
19830# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19831#elif defined(MFC_OpenMP)
19832# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19833
19834# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19835
19836# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19837!$omp end target teams loop
19838# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19839#endif
19840# 4537 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19841
19842 end if
19843
19844 if (qbmm) then
19845
19846# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19847
19848# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19849#if defined(MFC_OpenACC)
19850# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19851!$acc parallel loop collapse(4) gang vector default(present)
19852# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19853#elif defined(MFC_OpenMP)
19854# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19855
19856# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19857
19858# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19859
19860# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19861!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19862# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19863#endif
19864# 4541 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19865
19866 do i = 1, 4
19867 do l = is3%beg, is3%end
19868 do k = is2%beg, is2%end
19869 do j = is1%beg, is1%end + 1
19870 mom_sp_rsx_vf(j, k, l, i) = mom_sp(i)%sf(j, k, l)
19871 end do
19872 end do
19873 end do
19874 end do
19875
19876# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19877
19878# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19879#if defined(MFC_OpenACC)
19880# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19881!$acc end parallel loop
19882# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19883#elif defined(MFC_OpenMP)
19884# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19885
19886# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19887
19888# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19889!$omp end target teams loop
19890# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19891#endif
19892# 4551 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19893
19894 end if
19895
19896 ! Reshaping Inputted Data in y-direction
19897 elseif (norm_dir == 2) then
19898
19899 if (viscous .or. (surface_tension) .or. dummy) then
19900
19901# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19902
19903# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19904#if defined(MFC_OpenACC)
19905# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19906!$acc parallel loop collapse(4) gang vector default(present)
19907# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19908#elif defined(MFC_OpenMP)
19909# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19910
19911# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19912
19913# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19914
19915# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19916!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19917# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19918#endif
19919# 4558 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19920
19921 do i = momxb, e_idx
19922 do l = is3%beg, is3%end
19923 do j = is1%beg, is1%end
19924 do k = is2%beg, is2%end
19925 flux_src_vf(i)%sf(k, j, l) = 0._wp
19926 end do
19927 end do
19928 end do
19929 end do
19930
19931# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19932
19933# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19934#if defined(MFC_OpenACC)
19935# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19936!$acc end parallel loop
19937# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19938#elif defined(MFC_OpenMP)
19939# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19940
19941# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19942
19943# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19944!$omp end target teams loop
19945# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19946#endif
19947# 4568 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19948
19949 end if
19950
19951 if (chem_params%diffusion) then
19952
19953# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19954
19955# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19956#if defined(MFC_OpenACC)
19957# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19958!$acc parallel loop collapse(4) gang vector default(present)
19959# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19960#elif defined(MFC_OpenMP)
19961# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19962
19963# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19964
19965# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19966
19967# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19968!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
19969# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19970#endif
19971# 4572 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19972
19973 do i = e_idx, chemxe
19974 do l = is3%beg, is3%end
19975 do j = is1%beg, is1%end
19976 do k = is2%beg, is2%end
19977 if (i == e_idx .or. i >= chemxb) then
19978 flux_src_vf(i)%sf(k, j, l) = 0._wp
19979 end if
19980 end do
19981 end do
19982 end do
19983 end do
19984
19985# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19986
19987# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19988#if defined(MFC_OpenACC)
19989# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19990!$acc end parallel loop
19991# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19992#elif defined(MFC_OpenMP)
19993# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19994
19995# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19996
19997# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
19998!$omp end target teams loop
19999# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20000#endif
20001# 4584 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20002
20003 end if
20004
20005 if (qbmm) then
20006
20007# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20008
20009# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20010#if defined(MFC_OpenACC)
20011# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20012!$acc parallel loop collapse(4) gang vector default(present)
20013# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20014#elif defined(MFC_OpenMP)
20015# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20016
20017# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20018
20019# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20020
20021# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20022!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20023# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20024#endif
20025# 4588 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20026
20027 do i = 1, 4
20028 do l = is3%beg, is3%end
20029 do k = is2%beg, is2%end
20030 do j = is1%beg, is1%end + 1
20031 mom_sp_rsy_vf(j, k, l, i) = mom_sp(i)%sf(k, j, l)
20032 end do
20033 end do
20034 end do
20035 end do
20036
20037# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20038
20039# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20040#if defined(MFC_OpenACC)
20041# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20042!$acc end parallel loop
20043# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20044#elif defined(MFC_OpenMP)
20045# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20046
20047# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20048
20049# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20050!$omp end target teams loop
20051# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20052#endif
20053# 4598 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20054
20055 end if
20056
20057 ! Reshaping Inputted Data in z-direction
20058 else
20059
20060 if (viscous .or. (surface_tension) .or. dummy) then
20061
20062# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20063
20064# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20065#if defined(MFC_OpenACC)
20066# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20067!$acc parallel loop collapse(4) gang vector default(present)
20068# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20069#elif defined(MFC_OpenMP)
20070# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20071
20072# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20073
20074# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20075
20076# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20077!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20078# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20079#endif
20080# 4605 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20081
20082 do i = momxb, e_idx
20083 do j = is1%beg, is1%end
20084 do k = is2%beg, is2%end
20085 do l = is3%beg, is3%end
20086 flux_src_vf(i)%sf(l, k, j) = 0._wp
20087 end do
20088 end do
20089 end do
20090 end do
20091
20092# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20093
20094# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20095#if defined(MFC_OpenACC)
20096# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20097!$acc end parallel loop
20098# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20099#elif defined(MFC_OpenMP)
20100# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20101
20102# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20103
20104# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20105!$omp end target teams loop
20106# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20107#endif
20108# 4615 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20109
20110 end if
20111
20112 if (chem_params%diffusion) then
20113
20114# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20115
20116# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20117#if defined(MFC_OpenACC)
20118# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20119!$acc parallel loop collapse(4) gang vector default(present)
20120# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20121#elif defined(MFC_OpenMP)
20122# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20123
20124# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20125
20126# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20127
20128# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20129!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20130# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20131#endif
20132# 4619 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20133
20134 do i = e_idx, chemxe
20135 do j = is1%beg, is1%end
20136 do k = is2%beg, is2%end
20137 do l = is3%beg, is3%end
20138 if (i == e_idx .or. i >= chemxb) then
20139 flux_src_vf(i)%sf(l, k, j) = 0._wp
20140 end if
20141 end do
20142 end do
20143 end do
20144 end do
20145
20146# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20147
20148# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20149#if defined(MFC_OpenACC)
20150# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20151!$acc end parallel loop
20152# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20153#elif defined(MFC_OpenMP)
20154# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20155
20156# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20157
20158# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20159!$omp end target teams loop
20160# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20161#endif
20162# 4631 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20163
20164 end if
20165
20166 if (qbmm) then
20167
20168# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20169
20170# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20171#if defined(MFC_OpenACC)
20172# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20173!$acc parallel loop collapse(4) gang vector default(present)
20174# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20175#elif defined(MFC_OpenMP)
20176# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20177
20178# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20179
20180# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20181
20182# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20183!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20184# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20185#endif
20186# 4635 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20187
20188 do i = 1, 4
20189 do l = is3%beg, is3%end
20190 do k = is2%beg, is2%end
20191 do j = is1%beg, is1%end + 1
20192 mom_sp_rsz_vf(j, k, l, i) = mom_sp(i)%sf(l, k, j)
20193 end do
20194 end do
20195 end do
20196 end do
20197
20198# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20199
20200# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20201#if defined(MFC_OpenACC)
20202# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20203!$acc end parallel loop
20204# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20205#elif defined(MFC_OpenMP)
20206# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20207
20208# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20209
20210# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20211!$omp end target teams loop
20212# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20213#endif
20214# 4645 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20215
20216 end if
20217
20218 end if
20219
20220 end subroutine s_initialize_riemann_solver
20221
20222 !> @brief Computes cylindrical viscous source flux contributions for momentum and energy.
20223 !! Calculates Cartesian components of the stress tensor using averaged velocity derivatives
20224 !! and cylindrical geometric factors, then updates `flux_src_vf`.
20225 !! Assumes x-dir is axial (z_cyl), y-dir is radial (r_cyl), z-dir is azimuthal (theta_cyl for derivatives).
20226 !! @param[in] velL_vf Left boundary velocity (\f$v_x, v_y, v_z\f$) (num_dims scalar_field).
20227 !! @param[in] dvelL_dx_vf Left boundary \f$\partial v_i/\partial x\f$ (num_dims scalar_field).
20228 !! @param[in] dvelL_dy_vf Left boundary \f$\partial v_i/\partial y\f$ (num_dims scalar_field).
20229 !! @param[in] dvelL_dz_vf Left boundary \f$\partial v_i/\partial z\f$ (num_dims scalar_field).
20230 !! @param[in] velR_vf Right boundary velocity (\f$v_x, v_y, v_z\f$) (num_dims scalar_field).
20231 !! @param[in] dvelR_dx_vf Right boundary \f$\partial v_i/\partial x\f$ (num_dims scalar_field).
20232 !! @param[in] dvelR_dy_vf Right boundary \f$\partial v_i/\partial y\f$ (num_dims scalar_field).
20233 !! @param[in] dvelR_dz_vf Right boundary \f$\partial v_i/\partial z\f$ (num_dims scalar_field).
20234 !! @param[inout] flux_src_vf Intercell source flux array to update (sys_size scalar_field).
20235 !! @param[in] norm_dir Interface normal direction (1=x-face, 2=y-face, 3=z-face).
20236 !! @param[in] ix Global X-direction loop bounds (int_bounds_info).
20237 !! @param[in] iy Global Y-direction loop bounds (int_bounds_info).
20238 !! @param[in] iz Global Z-direction loop bounds (int_bounds_info).
20239 subroutine s_compute_cylindrical_viscous_source_flux(velL_vf, &
20240 dvelL_dx_vf, dvelL_dy_vf, dvelL_dz_vf, &
20241 velR_vf, &
20242 dvelR_dx_vf, dvelR_dy_vf, dvelR_dz_vf, &
20243 flux_src_vf, norm_dir, ix, iy, iz)
20244
20245 type(scalar_field), dimension(num_dims), intent(in) :: velL_vf, velR_vf
20246 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
20247 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
20248 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
20249 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
20250 integer, intent(in) :: norm_dir
20251 type(int_bounds_info), intent(in) :: ix, iy, iz
20252
20253 ! Local variables
20254# 4692 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20255 real(wp), dimension(num_dims) :: avg_v_int !!< Averaged interface velocity (\f$v_x, v_y, v_z\f$) (grid directions).
20256 real(wp), dimension(num_dims) :: avg_dvdx_int !!< Averaged interface \f$\partial v_i/\partial x\f$ (grid dir 1).
20257 real(wp), dimension(num_dims) :: avg_dvdy_int !!< Averaged interface \f$\partial v_i/\partial y\f$ (grid dir 2).
20258 real(wp), dimension(num_dims) :: avg_dvdz_int !!< Averaged interface \f$\partial v_i/\partial z\f$ (grid dir 3).
20259 real(wp), dimension(num_dims) :: vel_src_int !!< Interface velocity (\f$v_1,v_2,v_3\f$) (grid directions) for viscous work.
20260 real(wp), dimension(num_dims) :: stress_vector_shear !!< Shear stress vector (\f$\sigma_{N1}, \sigma_{N2}, \sigma_{N3}\f$) on N-face (grid directions).
20261# 4699 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20262 real(wp) :: stress_normal_bulk !!< Normal bulk stress component \f$\sigma_{NN}\f$ on N-face.
20263
20264 real(wp) :: Re_s, Re_b !!< Effective interface shear and bulk Reynolds numbers.
20265 real(wp) :: r_eff !!< Effective radius at interface for cylindrical terms.
20266 real(wp) :: div_v_term_const !!< Common term \f$-(2/3)(\nabla \cdot \mathbf{v}) / \text{Re}_s\f$ for shear stress diagonal.
20267 real(wp) :: divergence_cyl !!< Full divergence \f$\nabla \cdot \mathbf{v}\f$ in cylindrical coordinates.
20268
20269 integer :: j, k, l !!< Loop iterators for \f$x, y, z\f$ grid directions.
20270 integer :: i_vel !!< Loop iterator for velocity components.
20271 integer :: idx_rp(3) !!< Indices \f$(j,k,l)\f$ of 'right' point for averaging.
20272
20273
20274# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20275
20276# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20277#if defined(MFC_OpenACC)
20278# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20279!$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)
20280# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20281#elif defined(MFC_OpenMP)
20282# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20283
20284# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20285
20286# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20287
20288# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20289!$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)
20290# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20291#endif
20292# 4710 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20293
20294 do l = iz%beg, iz%end
20295 do k = iy%beg, iy%end
20296 do j = ix%beg, ix%end
20297
20298 ! Determine indices for the 'right' state for averaging across the interface
20299 idx_rp = [j, k, l]
20300 idx_rp(norm_dir) = idx_rp(norm_dir) + 1
20301
20302 ! Average velocities and their derivatives at the interface
20303 ! For cylindrical: x-dir ~ axial (z_cyl), y-dir ~ radial (r_cyl), z-dir ~ azimuthal (theta_cyl)
20304
20305# 4721 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20306#if defined(MFC_OpenACC)
20307# 4721 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20308!$acc loop seq
20309# 4721 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20310#elif defined(MFC_OpenMP)
20311# 4721 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20312
20313# 4721 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20314#endif
20315 do i_vel = 1, num_dims
20316 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)))
20317
20318 avg_dvdx_int(i_vel) = 0.5_wp*(dvell_dx_vf(i_vel)%sf(j, k, l) + &
20319 dvelr_dx_vf(i_vel)%sf(idx_rp(1), idx_rp(2), idx_rp(3)))
20320 if (num_dims > 1) then
20321 avg_dvdy_int(i_vel) = 0.5_wp*(dvell_dy_vf(i_vel)%sf(j, k, l) + &
20322 dvelr_dy_vf(i_vel)%sf(idx_rp(1), idx_rp(2), idx_rp(3)))
20323 else
20324 avg_dvdy_int(i_vel) = 0.0_wp
20325 end if
20326 if (num_dims > 2) then
20327 avg_dvdz_int(i_vel) = 0.5_wp*(dvell_dz_vf(i_vel)%sf(j, k, l) + &
20328 dvelr_dz_vf(i_vel)%sf(idx_rp(1), idx_rp(2), idx_rp(3)))
20329 else
20330 avg_dvdz_int(i_vel) = 0.0_wp
20331 end if
20332 end do
20333
20334 ! Get Re numbers and interface velocity for viscous work
20335 select case (norm_dir)
20336 case (1) ! x-face (axial face in z_cyl direction)
20337 re_s = re_avg_rsx_vf(j, k, l, 1)
20338 re_b = re_avg_rsx_vf(j, k, l, 2)
20339 vel_src_int = vel_src_rsx_vf(j, k, l, 1:num_dims)
20340 r_eff = y_cc(k)
20341 case (2) ! y-face (radial face in r_cyl direction)
20342 re_s = re_avg_rsy_vf(k, j, l, 1)
20343 re_b = re_avg_rsy_vf(k, j, l, 2)
20344 vel_src_int = vel_src_rsy_vf(k, j, l, 1:num_dims)
20345 r_eff = y_cb(k)
20346 case (3) ! z-face (azimuthal face in theta_cyl direction)
20347 re_s = re_avg_rsz_vf(l, k, j, 1)
20348 re_b = re_avg_rsz_vf(l, k, j, 2)
20349 vel_src_int = vel_src_rsz_vf(l, k, j, 1:num_dims)
20350 r_eff = y_cc(k)
20351 end select
20352
20353 ! Divergence in cylindrical coordinates (vx=vz_cyl, vy=vr_cyl, vz=vtheta_cyl)
20354# 4762 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20355 divergence_cyl = avg_dvdx_int(1) + avg_dvdy_int(2) + avg_v_int(2)/r_eff
20356 if (num_dims > 2) then
20357# 4765 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20358 divergence_cyl = divergence_cyl + avg_dvdz_int(3)/r_eff
20359# 4767 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20360 end if
20361# 4769 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20362
20363 stress_vector_shear = 0.0_wp
20364 stress_normal_bulk = 0.0_wp
20365
20366 if (shear_stress) then
20367 div_v_term_const = -(2.0_wp/3.0_wp)*divergence_cyl/re_s
20368
20369 select case (norm_dir)
20370 case (1) ! X-face (axial normal, z_cyl)
20371 stress_vector_shear(1) = (2.0_wp*avg_dvdx_int(1))/re_s + div_v_term_const
20372 if (num_dims > 1) then
20373# 4781 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20374 stress_vector_shear(2) = (avg_dvdy_int(1) + avg_dvdx_int(2))/re_s
20375# 4783 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20376 end if
20377 if (num_dims > 2) then
20378# 4786 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20379 stress_vector_shear(3) = (avg_dvdz_int(1)/r_eff + avg_dvdx_int(3))/re_s
20380# 4788 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20381 end if
20382 case (2) ! Y-face (radial normal, r_cyl)
20383 if (num_dims > 1) then
20384# 4792 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20385 stress_vector_shear(1) = (avg_dvdy_int(1) + avg_dvdx_int(2))/re_s
20386 stress_vector_shear(2) = (2.0_wp*avg_dvdy_int(2))/re_s + div_v_term_const
20387 if (num_dims > 2) then
20388# 4796 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20389 stress_vector_shear(3) = (avg_dvdz_int(2)/r_eff - avg_v_int(3)/r_eff + avg_dvdy_int(3))/re_s
20390# 4798 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20391 end if
20392# 4800 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20393 else
20394 stress_vector_shear(1) = (2.0_wp*avg_dvdx_int(1))/re_s + div_v_term_const
20395 end if
20396 case (3) ! Z-face (azimuthal normal, theta_cyl)
20397 if (num_dims > 2) then
20398# 4806 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20399 stress_vector_shear(1) = (avg_dvdz_int(1)/r_eff + avg_dvdx_int(3))/re_s
20400 stress_vector_shear(2) = (avg_dvdz_int(2)/r_eff - avg_v_int(3)/r_eff + avg_dvdy_int(3))/re_s
20401 stress_vector_shear(3) = (2.0_wp*(avg_dvdz_int(3)/r_eff + avg_v_int(2)/r_eff))/re_s + div_v_term_const
20402# 4810 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20403 end if
20404 end select
20405
20406
20407# 4813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20408#if defined(MFC_OpenACC)
20409# 4813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20410!$acc loop seq
20411# 4813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20412#elif defined(MFC_OpenMP)
20413# 4813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20414
20415# 4813 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20416#endif
20417 do i_vel = 1, num_dims
20418 flux_src_vf(momxb + i_vel - 1)%sf(j, k, l) = flux_src_vf(momxb + i_vel - 1)%sf(j, k, l) - stress_vector_shear(i_vel)
20419 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - vel_src_int(i_vel)*stress_vector_shear(i_vel)
20420 end do
20421 end if
20422
20423 if (bulk_stress) then
20424 stress_normal_bulk = divergence_cyl/re_b
20425
20426 flux_src_vf(momxb + norm_dir - 1)%sf(j, k, l) = flux_src_vf(momxb + norm_dir - 1)%sf(j, k, l) - stress_normal_bulk
20427 flux_src_vf(e_idx)%sf(j, k, l) = flux_src_vf(e_idx)%sf(j, k, l) - vel_src_int(norm_dir)*stress_normal_bulk
20428 end if
20429
20430 end do
20431 end do
20432 end do
20433
20434# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20435
20436# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20437#if defined(MFC_OpenACC)
20438# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20439!$acc end parallel loop
20440# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20441#elif defined(MFC_OpenMP)
20442# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20443
20444# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20445
20446# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20447!$omp end target teams loop
20448# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20449#endif
20450# 4830 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20451
20452
20453 end subroutine s_compute_cylindrical_viscous_source_flux
20454
20455 !> @brief Computes Cartesian viscous source flux contributions for momentum and energy.
20456 !! Calculates averaged velocity gradients, gets Re and interface velocities,
20457 !! calls helpers for shear/bulk stress, then updates `flux_src_vf`.
20458 !! @param[in] dvelL_dx_vf Left boundary d(vel)/dx (num_dims scalar_field).
20459 !! @param[in] dvelL_dy_vf Left boundary d(vel)/dy (num_dims scalar_field).
20460 !! @param[in] dvelL_dz_vf Left boundary d(vel)/dz (num_dims scalar_field).
20461 !! @param[in] dvelR_dx_vf Right boundary d(vel)/dx (num_dims scalar_field).
20462 !! @param[in] dvelR_dy_vf Right boundary d(vel)/dy (num_dims scalar_field).
20463 !! @param[in] dvelR_dz_vf Right boundary d(vel)/dz (num_dims scalar_field).
20464 !! @param[inout] flux_src_vf Intercell source flux array to update (sys_size scalar_field).
20465 !! @param[in] norm_dir Interface normal direction (1=x, 2=y, 3=z).
20466 subroutine s_compute_cartesian_viscous_source_flux(dvelL_dx_vf, &
20467 dvelL_dy_vf, &
20468 dvelL_dz_vf, &
20469 dvelR_dx_vf, &
20470 dvelR_dy_vf, &
20471 dvelR_dz_vf, &
20472 flux_src_vf, &
20473 norm_dir)
20474
20475 ! Arguments
20476 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dx_vf, dvelR_dx_vf
20477 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dy_vf, dvelR_dy_vf
20478 type(scalar_field), dimension(num_dims), intent(in) :: dvelL_dz_vf, dvelR_dz_vf
20479 type(scalar_field), dimension(sys_size), intent(inout) :: flux_src_vf
20480 integer, intent(in) :: norm_dir
20481
20482 ! Local variables
20483# 4868 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20484 real(wp), dimension(num_dims, num_dims) :: vel_grad_avg !< Averaged velocity gradient tensor `d(vel_i)/d(coord_j)`.
20485 real(wp), dimension(num_dims, num_dims) :: current_tau_shear !< Current shear stress tensor.
20486 real(wp), dimension(num_dims, num_dims) :: current_tau_bulk !< Current bulk stress tensor.
20487 real(wp), dimension(num_dims) :: vel_src_at_interface !< Interface velocities (u,v,w) for viscous work.
20488# 4873 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20489 integer, dimension(3) :: idx_right_phys !< Physical (j,k,l) indices for right state.
20490
20491 real(wp) :: Re_shear !< Interface shear Reynolds number.
20492 real(wp) :: Re_bulk !< Interface bulk Reynolds number.
20493
20494 integer :: j_loop !< Physical x-index loop iterator.
20495 integer :: k_loop !< Physical y-index loop iterator.
20496 integer :: l_loop !< Physical z-index loop iterator.
20497 integer :: i_dim !< Generic dimension/component iterator.
20498 integer :: vel_comp_idx !< Velocity component iterator (1=u, 2=v, 3=w).
20499
20500 real(wp) :: divergence_v !< Velocity divergence at interface.
20501
20502
20503# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20504
20505# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20506#if defined(MFC_OpenACC)
20507# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20508!$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)
20509# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20510#elif defined(MFC_OpenMP)
20511# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20512
20513# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20514
20515# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20516
20517# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20518!$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)
20519# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20520#endif
20521# 4886 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20522
20523 do l_loop = isz%beg, isz%end
20524 do k_loop = isy%beg, isy%end
20525 do j_loop = isx%beg, isx%end
20526
20527 idx_right_phys(1) = j_loop
20528 idx_right_phys(2) = k_loop
20529 idx_right_phys(3) = l_loop
20530 idx_right_phys(norm_dir) = idx_right_phys(norm_dir) + 1
20531
20532 vel_grad_avg = 0.0_wp
20533 do vel_comp_idx = 1, num_dims
20534 vel_grad_avg(vel_comp_idx, 1) = 0.5_wp*(dvell_dx_vf(vel_comp_idx)%sf(j_loop, k_loop, l_loop) + &
20535 dvelr_dx_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), idx_right_phys(3)))
20536 if (num_dims > 1) then
20537# 4902 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20538 vel_grad_avg(vel_comp_idx, 2) = 0.5_wp*(dvell_dy_vf(vel_comp_idx)%sf(j_loop, k_loop, l_loop) + &
20539 dvelr_dy_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), idx_right_phys(3)))
20540# 4905 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20541 end if
20542 if (num_dims > 2) then
20543# 4908 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20544 vel_grad_avg(vel_comp_idx, 3) = 0.5_wp*(dvell_dz_vf(vel_comp_idx)%sf(j_loop, k_loop, l_loop) + &
20545 dvelr_dz_vf(vel_comp_idx)%sf(idx_right_phys(1), idx_right_phys(2), idx_right_phys(3)))
20546# 4911 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20547 end if
20548 end do
20549
20550 divergence_v = 0.0_wp
20551 do i_dim = 1, num_dims
20552 divergence_v = divergence_v + vel_grad_avg(i_dim, i_dim)
20553 end do
20554
20555 vel_src_at_interface = 0.0_wp
20556 if (norm_dir == 1) then
20557 re_shear = re_avg_rsx_vf(j_loop, k_loop, l_loop, 1)
20558 re_bulk = re_avg_rsx_vf(j_loop, k_loop, l_loop, 2)
20559 do i_dim = 1, num_dims
20560 vel_src_at_interface(i_dim) = vel_src_rsx_vf(j_loop, k_loop, l_loop, i_dim)
20561 end do
20562 else if (norm_dir == 2) then
20563 re_shear = re_avg_rsy_vf(k_loop, j_loop, l_loop, 1)
20564 re_bulk = re_avg_rsy_vf(k_loop, j_loop, l_loop, 2)
20565 do i_dim = 1, num_dims
20566 vel_src_at_interface(i_dim) = vel_src_rsy_vf(k_loop, j_loop, l_loop, i_dim)
20567 end do
20568 else
20569 re_shear = re_avg_rsz_vf(l_loop, k_loop, j_loop, 1)
20570 re_bulk = re_avg_rsz_vf(l_loop, k_loop, j_loop, 2)
20571 do i_dim = 1, num_dims
20572 vel_src_at_interface(i_dim) = vel_src_rsz_vf(l_loop, k_loop, j_loop, i_dim)
20573 end do
20574 end if
20575
20576 if (shear_stress) then
20577 ! current_tau_shear = 0.0_wp
20578 call s_calculate_shear_stress_tensor(vel_grad_avg, re_shear, divergence_v, current_tau_shear)
20579
20580 do i_dim = 1, num_dims
20581 flux_src_vf(momxb + i_dim - 1)%sf(j_loop, k_loop, l_loop) = &
20582 flux_src_vf(momxb + i_dim - 1)%sf(j_loop, k_loop, l_loop) - current_tau_shear(norm_dir, i_dim)
20583
20584 flux_src_vf(e_idx)%sf(j_loop, k_loop, l_loop) = &
20585 flux_src_vf(e_idx)%sf(j_loop, k_loop, l_loop) - &
20586 vel_src_at_interface(i_dim)*current_tau_shear(norm_dir, i_dim)
20587 end do
20588 end if
20589
20590 if (bulk_stress) then
20591 ! current_tau_bulk = 0.0_wp
20592 call s_calculate_bulk_stress_tensor(re_bulk, divergence_v, current_tau_bulk)
20593
20594 do i_dim = 1, num_dims
20595 flux_src_vf(momxb + i_dim - 1)%sf(j_loop, k_loop, l_loop) = &
20596 flux_src_vf(momxb + i_dim - 1)%sf(j_loop, k_loop, l_loop) - current_tau_bulk(norm_dir, i_dim)
20597
20598 flux_src_vf(e_idx)%sf(j_loop, k_loop, l_loop) = &
20599 flux_src_vf(e_idx)%sf(j_loop, k_loop, l_loop) - &
20600 vel_src_at_interface(i_dim)*current_tau_bulk(norm_dir, i_dim)
20601 end do
20602 end if
20603
20604 end do
20605 end do
20606 end do
20607
20608# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20609
20610# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20611#if defined(MFC_OpenACC)
20612# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20613!$acc end parallel loop
20614# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20615#elif defined(MFC_OpenMP)
20616# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20617
20618# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20619
20620# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20621!$omp end target teams loop
20622# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20623#endif
20624# 4971 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20625
20626
20627 end subroutine s_compute_cartesian_viscous_source_flux
20628
20629 !> @brief Calculates shear stress tensor components.
20630 !! tau_ij_shear = ( (dui/dxj + duj/dxi) - (2/3)*(div_v)*delta_ij ) / Re_shear
20631 !! @param[in] vel_grad_avg Averaged velocity gradient tensor (d(vel_i)/d(coord_j)).
20632 !! @param[in] Re_shear Shear Reynolds number.
20633 !! @param[in] divergence_v Velocity divergence (du/dx + dv/dy + dw/dz).
20634 !! @param[out] tau_shear_out Calculated shear stress tensor (stress on i-face, j-direction).
20635 subroutine s_calculate_shear_stress_tensor(vel_grad_avg, Re_shear, divergence_v, tau_shear_out)
20636
20637# 4982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20638#if MFC_OpenACC
20639# 4982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20640!$acc routine seq
20641# 4982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20642#elif MFC_OpenMP
20643# 4982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20644
20645# 4982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20646
20647# 4982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20648!$omp declare target device_type(any)
20649# 4982 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20650#endif
20651
20652 ! Arguments
20653# 4989 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20654 real(wp), dimension(num_dims, num_dims), intent(in) :: vel_grad_avg
20655 real(wp), dimension(num_dims, num_dims), intent(out) :: tau_shear_out
20656# 4992 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20657 real(wp), intent(in) :: Re_shear
20658 real(wp), intent(in) :: divergence_v
20659
20660 ! Local variables
20661 integer :: i_dim !< Loop iterator for face normal.
20662 integer :: j_dim !< Loop iterator for force component direction.
20663
20664 tau_shear_out = 0.0_wp
20665
20666 do i_dim = 1, num_dims
20667 do j_dim = 1, num_dims
20668 tau_shear_out(i_dim, j_dim) = (vel_grad_avg(j_dim, i_dim) + vel_grad_avg(i_dim, j_dim))/re_shear
20669 if (i_dim == j_dim) then
20670 tau_shear_out(i_dim, j_dim) = tau_shear_out(i_dim, j_dim) - &
20671 (2.0_wp/3.0_wp)*divergence_v/re_shear
20672 end if
20673 end do
20674 end do
20675
20676 end subroutine s_calculate_shear_stress_tensor
20677
20678 !> @brief Calculates bulk stress tensor components (diagonal only).
20679 !! tau_ii_bulk = (div_v) / Re_bulk. Off-diagonals are zero.
20680 !! @param[in] Re_bulk Bulk Reynolds number.
20681 !! @param[in] divergence_v Velocity divergence (du/dx + dv/dy + dw/dz).
20682 !! @param[out] tau_bulk_out Calculated bulk stress tensor (stress on i-face, i-direction).
20683 subroutine s_calculate_bulk_stress_tensor(Re_bulk, divergence_v, tau_bulk_out)
20684
20685# 5019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20686#if MFC_OpenACC
20687# 5019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20688!$acc routine seq
20689# 5019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20690#elif MFC_OpenMP
20691# 5019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20692
20693# 5019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20694
20695# 5019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20696!$omp declare target device_type(any)
20697# 5019 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20698#endif
20699
20700 ! Arguments
20701 real(wp), intent(in) :: Re_bulk
20702 real(wp), intent(in) :: divergence_v
20703# 5027 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20704 real(wp), dimension(num_dims, num_dims), intent(out) :: tau_bulk_out
20705# 5029 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20706
20707 ! Local variables
20708 integer :: i_dim !< Loop iterator for diagonal components.
20709
20710 tau_bulk_out = 0.0_wp
20711
20712 do i_dim = 1, num_dims
20713 tau_bulk_out(i_dim, i_dim) = divergence_v/re_bulk
20714 end do
20715
20716 end subroutine s_calculate_bulk_stress_tensor
20717
20718 !> Deallocation and/or disassociation procedures that are
20719 !! needed to finalize the selected Riemann problem solver
20720 !! @param flux_vf Intercell fluxes
20721 !! @param flux_src_vf Intercell source fluxes
20722 !! @param flux_gsrc_vf Intercell geometric source fluxes
20723 !! @param norm_dir Dimensional splitting coordinate direction
20724 subroutine s_finalize_riemann_solver(flux_vf, flux_src_vf, &
20725 flux_gsrc_vf, &
20726 norm_dir)
20727
20728 type(scalar_field), &
20729 dimension(sys_size), &
20730 intent(inout) :: flux_vf, flux_src_vf, flux_gsrc_vf
20731
20732 integer, intent(in) :: norm_dir
20733
20734 integer :: i, j, k, l !< Generic loop iterators
20735
20736 ! Reshaping Outputted Data in y-direction
20737 if (norm_dir == 2) then
20738
20739# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20740
20741# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20742#if defined(MFC_OpenACC)
20743# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20744!$acc parallel loop collapse(4) gang vector default(present)
20745# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20746#elif defined(MFC_OpenMP)
20747# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20748
20749# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20750
20751# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20752
20753# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20754!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20755# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20756#endif
20757# 5061 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20758
20759 do i = 1, sys_size
20760 do l = is3%beg, is3%end
20761 do j = is1%beg, is1%end
20762 do k = is2%beg, is2%end
20763 flux_vf(i)%sf(k, j, l) = &
20764 flux_rsy_vf(j, k, l, i)
20765 end do
20766 end do
20767 end do
20768 end do
20769
20770# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20771
20772# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20773#if defined(MFC_OpenACC)
20774# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20775!$acc end parallel loop
20776# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20777#elif defined(MFC_OpenMP)
20778# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20779
20780# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20781
20782# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20783!$omp end target teams loop
20784# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20785#endif
20786# 5072 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20787
20788
20789 if (cyl_coord) then
20790
20791# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20792
20793# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20794#if defined(MFC_OpenACC)
20795# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20796!$acc parallel loop collapse(4) gang vector default(present)
20797# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20798#elif defined(MFC_OpenMP)
20799# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20800
20801# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20802
20803# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20804
20805# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20806!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20807# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20808#endif
20809# 5075 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20810
20811 do i = 1, sys_size
20812 do l = is3%beg, is3%end
20813 do j = is1%beg, is1%end
20814 do k = is2%beg, is2%end
20815 flux_gsrc_vf(i)%sf(k, j, l) = &
20816 flux_gsrc_rsy_vf(j, k, l, i)
20817 end do
20818 end do
20819 end do
20820 end do
20821
20822# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20823
20824# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20825#if defined(MFC_OpenACC)
20826# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20827!$acc end parallel loop
20828# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20829#elif defined(MFC_OpenMP)
20830# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20831
20832# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20833
20834# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20835!$omp end target teams loop
20836# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20837#endif
20838# 5086 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20839
20840 end if
20841
20842
20843# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20844
20845# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20846#if defined(MFC_OpenACC)
20847# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20848!$acc parallel loop collapse(3) gang vector default(present)
20849# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20850#elif defined(MFC_OpenMP)
20851# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20852
20853# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20854
20855# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20856
20857# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20858!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20859# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20860#endif
20861# 5089 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20862
20863 do l = is3%beg, is3%end
20864 do j = is1%beg, is1%end
20865 do k = is2%beg, is2%end
20866 flux_src_vf(advxb)%sf(k, j, l) = &
20867 flux_src_rsy_vf(j, k, l, advxb)
20868 end do
20869 end do
20870 end do
20871
20872# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20873
20874# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20875#if defined(MFC_OpenACC)
20876# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20877!$acc end parallel loop
20878# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20879#elif defined(MFC_OpenMP)
20880# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20881
20882# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20883
20884# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20885!$omp end target teams loop
20886# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20887#endif
20888# 5098 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20889
20890
20891 if (riemann_solver == 1 .or. riemann_solver == 4) then
20892
20893# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20894
20895# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20896#if defined(MFC_OpenACC)
20897# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20898!$acc parallel loop collapse(4) gang vector default(present)
20899# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20900#elif defined(MFC_OpenMP)
20901# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20902
20903# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20904
20905# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20906
20907# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20908!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20909# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20910#endif
20911# 5101 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20912
20913 do i = advxb + 1, advxe
20914 do l = is3%beg, is3%end
20915 do j = is1%beg, is1%end
20916 do k = is2%beg, is2%end
20917 flux_src_vf(i)%sf(k, j, l) = &
20918 flux_src_rsy_vf(j, k, l, i)
20919 end do
20920 end do
20921 end do
20922 end do
20923
20924# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20925
20926# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20927#if defined(MFC_OpenACC)
20928# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20929!$acc end parallel loop
20930# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20931#elif defined(MFC_OpenMP)
20932# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20933
20934# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20935
20936# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20937!$omp end target teams loop
20938# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20939#endif
20940# 5112 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20941
20942
20943 end if
20944 ! Reshaping Outputted Data in z-direction
20945 elseif (norm_dir == 3) then
20946
20947# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20948
20949# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20950#if defined(MFC_OpenACC)
20951# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20952!$acc parallel loop collapse(4) gang vector default(present)
20953# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20954#elif defined(MFC_OpenMP)
20955# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20956
20957# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20958
20959# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20960
20961# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20962!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
20963# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20964#endif
20965# 5117 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20966
20967 do i = 1, sys_size
20968 do j = is1%beg, is1%end
20969 do k = is2%beg, is2%end
20970 do l = is3%beg, is3%end
20971
20972 flux_vf(i)%sf(l, k, j) = &
20973 flux_rsz_vf(j, k, l, i)
20974 end do
20975 end do
20976 end do
20977 end do
20978
20979# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20980
20981# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20982#if defined(MFC_OpenACC)
20983# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20984!$acc end parallel loop
20985# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20986#elif defined(MFC_OpenMP)
20987# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20988
20989# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20990
20991# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20992!$omp end target teams loop
20993# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20994#endif
20995# 5129 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
20996
20997 if (grid_geometry == 3) then
20998
20999# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21000
21001# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21002#if defined(MFC_OpenACC)
21003# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21004!$acc parallel loop collapse(4) gang vector default(present)
21005# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21006#elif defined(MFC_OpenMP)
21007# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21008
21009# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21010
21011# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21012
21013# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21014!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
21015# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21016#endif
21017# 5131 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21018
21019 do i = 1, sys_size
21020 do j = is1%beg, is1%end
21021 do k = is2%beg, is2%end
21022 do l = is3%beg, is3%end
21023
21024 flux_gsrc_vf(i)%sf(l, k, j) = &
21025 flux_gsrc_rsz_vf(j, k, l, i)
21026 end do
21027 end do
21028 end do
21029 end do
21030
21031# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21032
21033# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21034#if defined(MFC_OpenACC)
21035# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21036!$acc end parallel loop
21037# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21038#elif defined(MFC_OpenMP)
21039# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21040
21041# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21042
21043# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21044!$omp end target teams loop
21045# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21046#endif
21047# 5143 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21048
21049 end if
21050
21051
21052# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21053
21054# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21055#if defined(MFC_OpenACC)
21056# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21057!$acc parallel loop collapse(3) gang vector default(present)
21058# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21059#elif defined(MFC_OpenMP)
21060# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21061
21062# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21063
21064# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21065
21066# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21067!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
21068# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21069#endif
21070# 5146 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21071
21072 do j = is1%beg, is1%end
21073 do k = is2%beg, is2%end
21074 do l = is3%beg, is3%end
21075 flux_src_vf(advxb)%sf(l, k, j) = &
21076 flux_src_rsz_vf(j, k, l, advxb)
21077 end do
21078 end do
21079 end do
21080
21081# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21082
21083# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21084#if defined(MFC_OpenACC)
21085# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21086!$acc end parallel loop
21087# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21088#elif defined(MFC_OpenMP)
21089# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21090
21091# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21092
21093# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21094!$omp end target teams loop
21095# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21096#endif
21097# 5155 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21098
21099
21100 if (riemann_solver == 1 .or. riemann_solver == 4) then
21101
21102# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21103
21104# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21105#if defined(MFC_OpenACC)
21106# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21107!$acc parallel loop collapse(4) gang vector default(present)
21108# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21109#elif defined(MFC_OpenMP)
21110# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21111
21112# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21113
21114# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21115
21116# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21117!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
21118# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21119#endif
21120# 5158 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21121
21122 do i = advxb + 1, advxe
21123 do j = is1%beg, is1%end
21124 do k = is2%beg, is2%end
21125 do l = is3%beg, is3%end
21126 flux_src_vf(i)%sf(l, k, j) = &
21127 flux_src_rsz_vf(j, k, l, i)
21128 end do
21129 end do
21130 end do
21131 end do
21132
21133# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21134
21135# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21136#if defined(MFC_OpenACC)
21137# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21138!$acc end parallel loop
21139# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21140#elif defined(MFC_OpenMP)
21141# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21142
21143# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21144
21145# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21146!$omp end target teams loop
21147# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21148#endif
21149# 5169 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21150
21151
21152 end if
21153 elseif (norm_dir == 1) then
21154
21155# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21156
21157# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21158#if defined(MFC_OpenACC)
21159# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21160!$acc parallel loop collapse(4) gang vector default(present)
21161# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21162#elif defined(MFC_OpenMP)
21163# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21164
21165# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21166
21167# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21168
21169# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21170!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
21171# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21172#endif
21173# 5173 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21174
21175 do i = 1, sys_size
21176 do l = is3%beg, is3%end
21177 do k = is2%beg, is2%end
21178 do j = is1%beg, is1%end
21179 flux_vf(i)%sf(j, k, l) = &
21180 flux_rsx_vf(j, k, l, i)
21181 end do
21182 end do
21183 end do
21184 end do
21185
21186# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21187
21188# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21189#if defined(MFC_OpenACC)
21190# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21191!$acc end parallel loop
21192# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21193#elif defined(MFC_OpenMP)
21194# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21195
21196# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21197
21198# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21199!$omp end target teams loop
21200# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21201#endif
21202# 5184 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21203
21204
21205
21206# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21207
21208# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21209#if defined(MFC_OpenACC)
21210# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21211!$acc parallel loop collapse(3) gang vector default(present)
21212# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21213#elif defined(MFC_OpenMP)
21214# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21215
21216# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21217
21218# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21219
21220# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21221!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(3) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
21222# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21223#endif
21224# 5186 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21225
21226 do l = is3%beg, is3%end
21227 do k = is2%beg, is2%end
21228 do j = is1%beg, is1%end
21229 flux_src_vf(advxb)%sf(j, k, l) = &
21230 flux_src_rsx_vf(j, k, l, advxb)
21231 end do
21232 end do
21233 end do
21234
21235# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21236
21237# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21238#if defined(MFC_OpenACC)
21239# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21240!$acc end parallel loop
21241# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21242#elif defined(MFC_OpenMP)
21243# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21244
21245# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21246
21247# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21248!$omp end target teams loop
21249# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21250#endif
21251# 5195 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21252
21253
21254 if (riemann_solver == 1 .or. riemann_solver == 4) then
21255
21256# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21257
21258# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21259#if defined(MFC_OpenACC)
21260# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21261!$acc parallel loop collapse(4) gang vector default(present)
21262# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21263#elif defined(MFC_OpenMP)
21264# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21265
21266# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21267
21268# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21269
21270# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21271!$omp target teams loop defaultmap(firstprivate:scalar) bind(teams,parallel) collapse(4) defaultmap(tofrom:aggregate) defaultmap(tofrom:allocatable) defaultmap(tofrom:pointer)
21272# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21273#endif
21274# 5198 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21275
21276 do i = advxb + 1, advxe
21277 do l = is3%beg, is3%end
21278 do k = is2%beg, is2%end
21279 do j = is1%beg, is1%end
21280 flux_src_vf(i)%sf(j, k, l) = &
21281 flux_src_rsx_vf(j, k, l, i)
21282 end do
21283 end do
21284 end do
21285 end do
21286
21287# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21288
21289# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21290#if defined(MFC_OpenACC)
21291# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21292!$acc end parallel loop
21293# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21294#elif defined(MFC_OpenMP)
21295# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21296
21297# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21298
21299# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21300!$omp end target teams loop
21301# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21302#endif
21303# 5209 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21304
21305 end if
21306 end if
21307
21308 end subroutine s_finalize_riemann_solver
21309
21310 !> Module deallocation and/or disassociation procedures
21311 impure subroutine s_finalize_riemann_solvers_module
21312
21313 if (viscous) then
21314#ifdef MFC_DEBUG
21315# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21316 block
21317# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21318 use iso_fortran_env, only: output_unit
21319# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21320
21321# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21322 print *, 'm_riemann_solvers.fpp:5219: ', '@:DEALLOCATE(Re_avg_rsx_vf)'
21323# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21324
21325# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21326 call flush (output_unit)
21327# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21328 end block
21329# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21330#endif
21331# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21332
21333# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21334#if defined(MFC_OpenACC)
21335# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21336!$acc exit data delete(Re_avg_rsx_vf)
21337# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21338#elif defined(MFC_OpenMP)
21339# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21340!$omp target exit data map(release:Re_avg_rsx_vf)
21341# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21342#endif
21343# 5219 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21344 deallocate (re_avg_rsx_vf)
21345 end if
21346#ifdef MFC_DEBUG
21347# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21348 block
21349# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21350 use iso_fortran_env, only: output_unit
21351# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21352
21353# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21354 print *, 'm_riemann_solvers.fpp:5221: ', '@:DEALLOCATE(vel_src_rsx_vf)'
21355# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21356
21357# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21358 call flush (output_unit)
21359# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21360 end block
21361# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21362#endif
21363# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21364
21365# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21366#if defined(MFC_OpenACC)
21367# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21368!$acc exit data delete(vel_src_rsx_vf)
21369# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21370#elif defined(MFC_OpenMP)
21371# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21372!$omp target exit data map(release:vel_src_rsx_vf)
21373# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21374#endif
21375# 5221 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21376 deallocate (vel_src_rsx_vf)
21377#ifdef MFC_DEBUG
21378# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21379 block
21380# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21381 use iso_fortran_env, only: output_unit
21382# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21383
21384# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21385 print *, 'm_riemann_solvers.fpp:5222: ', '@:DEALLOCATE(flux_rsx_vf)'
21386# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21387
21388# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21389 call flush (output_unit)
21390# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21391 end block
21392# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21393#endif
21394# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21395
21396# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21397#if defined(MFC_OpenACC)
21398# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21399!$acc exit data delete(flux_rsx_vf)
21400# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21401#elif defined(MFC_OpenMP)
21402# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21403!$omp target exit data map(release:flux_rsx_vf)
21404# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21405#endif
21406# 5222 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21407 deallocate (flux_rsx_vf)
21408#ifdef MFC_DEBUG
21409# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21410 block
21411# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21412 use iso_fortran_env, only: output_unit
21413# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21414
21415# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21416 print *, 'm_riemann_solvers.fpp:5223: ', '@:DEALLOCATE(flux_src_rsx_vf)'
21417# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21418
21419# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21420 call flush (output_unit)
21421# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21422 end block
21423# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21424#endif
21425# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21426
21427# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21428#if defined(MFC_OpenACC)
21429# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21430!$acc exit data delete(flux_src_rsx_vf)
21431# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21432#elif defined(MFC_OpenMP)
21433# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21434!$omp target exit data map(release:flux_src_rsx_vf)
21435# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21436#endif
21437# 5223 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21438 deallocate (flux_src_rsx_vf)
21439#ifdef MFC_DEBUG
21440# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21441 block
21442# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21443 use iso_fortran_env, only: output_unit
21444# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21445
21446# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21447 print *, 'm_riemann_solvers.fpp:5224: ', '@:DEALLOCATE(flux_gsrc_rsx_vf)'
21448# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21449
21450# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21451 call flush (output_unit)
21452# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21453 end block
21454# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21455#endif
21456# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21457
21458# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21459#if defined(MFC_OpenACC)
21460# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21461!$acc exit data delete(flux_gsrc_rsx_vf)
21462# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21463#elif defined(MFC_OpenMP)
21464# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21465!$omp target exit data map(release:flux_gsrc_rsx_vf)
21466# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21467#endif
21468# 5224 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21469 deallocate (flux_gsrc_rsx_vf)
21470 if (qbmm) then
21471#ifdef MFC_DEBUG
21472# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21473 block
21474# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21475 use iso_fortran_env, only: output_unit
21476# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21477
21478# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21479 print *, 'm_riemann_solvers.fpp:5226: ', '@:DEALLOCATE(mom_sp_rsx_vf)'
21480# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21481
21482# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21483 call flush (output_unit)
21484# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21485 end block
21486# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21487#endif
21488# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21489
21490# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21491#if defined(MFC_OpenACC)
21492# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21493!$acc exit data delete(mom_sp_rsx_vf)
21494# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21495#elif defined(MFC_OpenMP)
21496# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21497!$omp target exit data map(release:mom_sp_rsx_vf)
21498# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21499#endif
21500# 5226 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21501 deallocate (mom_sp_rsx_vf)
21502 end if
21503
21504 if (n == 0) return
21505
21506 if (viscous) then
21507#ifdef MFC_DEBUG
21508# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21509 block
21510# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21511 use iso_fortran_env, only: output_unit
21512# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21513
21514# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21515 print *, 'm_riemann_solvers.fpp:5232: ', '@:DEALLOCATE(Re_avg_rsy_vf)'
21516# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21517
21518# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21519 call flush (output_unit)
21520# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21521 end block
21522# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21523#endif
21524# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21525
21526# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21527#if defined(MFC_OpenACC)
21528# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21529!$acc exit data delete(Re_avg_rsy_vf)
21530# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21531#elif defined(MFC_OpenMP)
21532# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21533!$omp target exit data map(release:Re_avg_rsy_vf)
21534# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21535#endif
21536# 5232 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21537 deallocate (re_avg_rsy_vf)
21538 end if
21539#ifdef MFC_DEBUG
21540# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21541 block
21542# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21543 use iso_fortran_env, only: output_unit
21544# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21545
21546# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21547 print *, 'm_riemann_solvers.fpp:5234: ', '@:DEALLOCATE(vel_src_rsy_vf)'
21548# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21549
21550# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21551 call flush (output_unit)
21552# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21553 end block
21554# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21555#endif
21556# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21557
21558# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21559#if defined(MFC_OpenACC)
21560# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21561!$acc exit data delete(vel_src_rsy_vf)
21562# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21563#elif defined(MFC_OpenMP)
21564# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21565!$omp target exit data map(release:vel_src_rsy_vf)
21566# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21567#endif
21568# 5234 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21569 deallocate (vel_src_rsy_vf)
21570#ifdef MFC_DEBUG
21571# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21572 block
21573# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21574 use iso_fortran_env, only: output_unit
21575# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21576
21577# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21578 print *, 'm_riemann_solvers.fpp:5235: ', '@:DEALLOCATE(flux_rsy_vf)'
21579# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21580
21581# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21582 call flush (output_unit)
21583# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21584 end block
21585# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21586#endif
21587# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21588
21589# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21590#if defined(MFC_OpenACC)
21591# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21592!$acc exit data delete(flux_rsy_vf)
21593# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21594#elif defined(MFC_OpenMP)
21595# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21596!$omp target exit data map(release:flux_rsy_vf)
21597# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21598#endif
21599# 5235 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21600 deallocate (flux_rsy_vf)
21601#ifdef MFC_DEBUG
21602# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21603 block
21604# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21605 use iso_fortran_env, only: output_unit
21606# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21607
21608# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21609 print *, 'm_riemann_solvers.fpp:5236: ', '@:DEALLOCATE(flux_src_rsy_vf)'
21610# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21611
21612# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21613 call flush (output_unit)
21614# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21615 end block
21616# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21617#endif
21618# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21619
21620# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21621#if defined(MFC_OpenACC)
21622# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21623!$acc exit data delete(flux_src_rsy_vf)
21624# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21625#elif defined(MFC_OpenMP)
21626# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21627!$omp target exit data map(release:flux_src_rsy_vf)
21628# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21629#endif
21630# 5236 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21631 deallocate (flux_src_rsy_vf)
21632#ifdef MFC_DEBUG
21633# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21634 block
21635# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21636 use iso_fortran_env, only: output_unit
21637# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21638
21639# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21640 print *, 'm_riemann_solvers.fpp:5237: ', '@:DEALLOCATE(flux_gsrc_rsy_vf)'
21641# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21642
21643# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21644 call flush (output_unit)
21645# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21646 end block
21647# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21648#endif
21649# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21650
21651# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21652#if defined(MFC_OpenACC)
21653# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21654!$acc exit data delete(flux_gsrc_rsy_vf)
21655# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21656#elif defined(MFC_OpenMP)
21657# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21658!$omp target exit data map(release:flux_gsrc_rsy_vf)
21659# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21660#endif
21661# 5237 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21662 deallocate (flux_gsrc_rsy_vf)
21663 if (qbmm) then
21664#ifdef MFC_DEBUG
21665# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21666 block
21667# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21668 use iso_fortran_env, only: output_unit
21669# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21670
21671# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21672 print *, 'm_riemann_solvers.fpp:5239: ', '@:DEALLOCATE(mom_sp_rsy_vf)'
21673# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21674
21675# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21676 call flush (output_unit)
21677# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21678 end block
21679# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21680#endif
21681# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21682
21683# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21684#if defined(MFC_OpenACC)
21685# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21686!$acc exit data delete(mom_sp_rsy_vf)
21687# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21688#elif defined(MFC_OpenMP)
21689# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21690!$omp target exit data map(release:mom_sp_rsy_vf)
21691# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21692#endif
21693# 5239 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21694 deallocate (mom_sp_rsy_vf)
21695 end if
21696
21697 if (p == 0) return
21698
21699 if (viscous) then
21700#ifdef MFC_DEBUG
21701# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21702 block
21703# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21704 use iso_fortran_env, only: output_unit
21705# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21706
21707# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21708 print *, 'm_riemann_solvers.fpp:5245: ', '@:DEALLOCATE(Re_avg_rsz_vf)'
21709# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21710
21711# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21712 call flush (output_unit)
21713# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21714 end block
21715# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21716#endif
21717# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21718
21719# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21720#if defined(MFC_OpenACC)
21721# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21722!$acc exit data delete(Re_avg_rsz_vf)
21723# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21724#elif defined(MFC_OpenMP)
21725# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21726!$omp target exit data map(release:Re_avg_rsz_vf)
21727# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21728#endif
21729# 5245 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21730 deallocate (re_avg_rsz_vf)
21731 end if
21732#ifdef MFC_DEBUG
21733# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21734 block
21735# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21736 use iso_fortran_env, only: output_unit
21737# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21738
21739# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21740 print *, 'm_riemann_solvers.fpp:5247: ', '@:DEALLOCATE(vel_src_rsz_vf)'
21741# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21742
21743# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21744 call flush (output_unit)
21745# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21746 end block
21747# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21748#endif
21749# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21750
21751# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21752#if defined(MFC_OpenACC)
21753# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21754!$acc exit data delete(vel_src_rsz_vf)
21755# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21756#elif defined(MFC_OpenMP)
21757# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21758!$omp target exit data map(release:vel_src_rsz_vf)
21759# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21760#endif
21761# 5247 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21762 deallocate (vel_src_rsz_vf)
21763#ifdef MFC_DEBUG
21764# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21765 block
21766# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21767 use iso_fortran_env, only: output_unit
21768# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21769
21770# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21771 print *, 'm_riemann_solvers.fpp:5248: ', '@:DEALLOCATE(flux_rsz_vf)'
21772# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21773
21774# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21775 call flush (output_unit)
21776# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21777 end block
21778# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21779#endif
21780# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21781
21782# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21783#if defined(MFC_OpenACC)
21784# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21785!$acc exit data delete(flux_rsz_vf)
21786# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21787#elif defined(MFC_OpenMP)
21788# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21789!$omp target exit data map(release:flux_rsz_vf)
21790# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21791#endif
21792# 5248 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21793 deallocate (flux_rsz_vf)
21794#ifdef MFC_DEBUG
21795# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21796 block
21797# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21798 use iso_fortran_env, only: output_unit
21799# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21800
21801# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21802 print *, 'm_riemann_solvers.fpp:5249: ', '@:DEALLOCATE(flux_src_rsz_vf)'
21803# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21804
21805# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21806 call flush (output_unit)
21807# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21808 end block
21809# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21810#endif
21811# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21812
21813# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21814#if defined(MFC_OpenACC)
21815# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21816!$acc exit data delete(flux_src_rsz_vf)
21817# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21818#elif defined(MFC_OpenMP)
21819# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21820!$omp target exit data map(release:flux_src_rsz_vf)
21821# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21822#endif
21823# 5249 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21824 deallocate (flux_src_rsz_vf)
21825#ifdef MFC_DEBUG
21826# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21827 block
21828# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21829 use iso_fortran_env, only: output_unit
21830# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21831
21832# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21833 print *, 'm_riemann_solvers.fpp:5250: ', '@:DEALLOCATE(flux_gsrc_rsz_vf)'
21834# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21835
21836# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21837 call flush (output_unit)
21838# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21839 end block
21840# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21841#endif
21842# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21843
21844# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21845#if defined(MFC_OpenACC)
21846# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21847!$acc exit data delete(flux_gsrc_rsz_vf)
21848# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21849#elif defined(MFC_OpenMP)
21850# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21851!$omp target exit data map(release:flux_gsrc_rsz_vf)
21852# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21853#endif
21854# 5250 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21855 deallocate (flux_gsrc_rsz_vf)
21856 if (qbmm) then
21857#ifdef MFC_DEBUG
21858# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21859 block
21860# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21861 use iso_fortran_env, only: output_unit
21862# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21863
21864# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21865 print *, 'm_riemann_solvers.fpp:5252: ', '@:DEALLOCATE(mom_sp_rsz_vf)'
21866# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21867
21868# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21869 call flush (output_unit)
21870# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21871 end block
21872# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21873#endif
21874# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21875
21876# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21877#if defined(MFC_OpenACC)
21878# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21879!$acc exit data delete(mom_sp_rsz_vf)
21880# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21881#elif defined(MFC_OpenMP)
21882# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21883!$omp target exit data map(release:mom_sp_rsz_vf)
21884# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21885#endif
21886# 5252 "/home/runner/work/MFC/MFC/src/simulation/m_riemann_solvers.fpp"
21887 deallocate (mom_sp_rsz_vf)
21888 end if
21889
21890 end subroutine s_finalize_riemann_solvers_module
21891
21892end module m_riemann_solvers
k
integer, intent(in) k
Definition m_phase_change.fpp.f90:1121
j
integer, intent(in) j
Definition m_phase_change.fpp.f90:1121
l
integer, intent(in) l
Definition m_phase_change.fpp.f90:1121
m_bubbles_ee
Computes ensemble-averaged (Euler–Euler) bubble source terms for radius, velocity,...
Definition m_bubbles_EE.fpp.f90:292
m_bubbles_ee::vs
integer, dimension(:), allocatable vs
Definition m_bubbles_EE.fpp.f90:333
m_bubbles_ee::ps
integer, dimension(:), allocatable ps
Definition m_bubbles_EE.fpp.f90:333
m_bubbles_ee::rs
integer, dimension(:), allocatable rs
Definition m_bubbles_EE.fpp.f90:333
m_bubbles
Shared bubble-dynamics procedures (radial acceleration, wall pressure, sound speed) for ensemble- and...
Definition m_bubbles.fpp.f90:292
m_bubbles::f_cpbw_km
elemental real(wp) function f_cpbw_km(fr0, fr, fv, fpb)
Function that computes the bubble wall pressure for Keller–Miksis bubbles.
Definition m_bubbles.fpp.f90:667
m_chemistry
Multi-species chemistry interface for thermodynamic properties, reaction rates, and transport coeffic...
Definition m_chemistry.fpp.f90:304
m_chemistry::compute_viscosity_and_inversion
subroutine compute_viscosity_and_inversion(t_l, ys_l, t_r, ys_r, re_l, re_r)
Computes mixture viscosities for left and right states and inverts them for use as reciprocal Reynold...
Definition m_chemistry.fpp.f90:348
m_derived_types
Shared derived types for field data, patch geometry, bubble dynamics, and MPI I/O structures.
Definition m_derived_types.fpp.f90:292
m_global_parameters
Global parameters for the computational domain, fluid properties, and simulation algorithm configurat...
Definition m_global_parameters.fpp.f90:303
m_global_parameters::bubbles_euler
logical bubbles_euler
Bubbles euler on/off.
Definition m_global_parameters.fpp.f90:1062
m_global_parameters::contxb
integer contxb
Definition m_global_parameters.fpp.f90:1290
m_global_parameters::re_size
integer, dimension(2) re_size
Definition m_global_parameters.fpp.f90:846
m_global_parameters::bulk_stress
logical bulk_stress
Bulk stresses.
Definition m_global_parameters.fpp.f90:484
m_global_parameters::bubxb
integer bubxb
Definition m_global_parameters.fpp.f90:1292
m_global_parameters::grid_geometry
integer grid_geometry
Definition m_global_parameters.fpp.f90:345
m_global_parameters::wave_speeds
integer wave_speeds
Wave speeds estimation method.
Definition m_global_parameters.fpp.f90:470
m_global_parameters::cont_damage
logical cont_damage
Continuum damage modeling.
Definition m_global_parameters.fpp.f90:485
m_global_parameters::hypoelasticity
logical hypoelasticity
hypoelasticity modeling
Definition m_global_parameters.fpp.f90:475
m_global_parameters::avg_state
integer avg_state
Average state evaluation method.
Definition m_global_parameters.fpp.f90:471
m_global_parameters::chemistry
logical, parameter chemistry
Chemistry modeling.
Definition m_global_parameters.fpp.f90:482
m_global_parameters::xibeg
integer xibeg
Definition m_global_parameters.fpp.f90:1295
m_global_parameters::num_fluids
integer num_fluids
number of fluids in the simulation
Definition m_global_parameters.fpp.f90:438
m_global_parameters::momxe
integer momxe
Definition m_global_parameters.fpp.f90:1288
m_global_parameters::weno_re_flux
logical weno_re_flux
WENO reconstruct velocity gradients for viscous stress tensor.
Definition m_global_parameters.fpp.f90:467
m_global_parameters::hyper_cleaning_speed
real(wp) hyper_cleaning_speed
Hyperbolic cleaning wave speed (c_h).
Definition m_global_parameters.fpp.f90:1428
m_global_parameters::n_idx
integer n_idx
Index of number density.
Definition m_global_parameters.fpp.f90:760
m_global_parameters::dummy
logical dummy
AMDFlang workaround: keep a dummy logical to avoid a compiler case-optimization bug when a parameter+...
Definition m_global_parameters.fpp.f90:1406
m_global_parameters::xiend
integer xiend
Definition m_global_parameters.fpp.f90:1295
m_global_parameters::sys_size
integer sys_size
Number of unknowns in system of eqns.
Definition m_global_parameters.fpp.f90:756
m_global_parameters::weight
real(wp), dimension(:), allocatable weight
Simpson quadrature weights.
Definition m_global_parameters.fpp.f90:1048
m_global_parameters::advxe
integer advxe
Definition m_global_parameters.fpp.f90:1289
m_global_parameters::cyl_coord
logical cyl_coord
Definition m_global_parameters.fpp.f90:344
m_global_parameters::strxe
integer strxe
Definition m_global_parameters.fpp.f90:1293
m_global_parameters::dir_idx
integer, dimension(3) dir_idx
Definition m_global_parameters.fpp.f90:889
m_global_parameters::chemxb
integer chemxb
Definition m_global_parameters.fpp.f90:1294
m_global_parameters::viscous
logical viscous
Viscous effects.
Definition m_global_parameters.fpp.f90:450
m_global_parameters::b_idx
type(int_bounds_info) b_idx
Indexes of first and last magnetic field eqns.
Definition m_global_parameters.fpp.f90:767
m_global_parameters::riemann_solver
integer riemann_solver
Riemann solver algorithm.
Definition m_global_parameters.fpp.f90:468
m_global_parameters::model_eqns
integer model_eqns
Multicomponent flow model.
Definition m_global_parameters.fpp.f90:421
m_global_parameters::hyperelasticity
logical hyperelasticity
hyperelasticity modeling
Definition m_global_parameters.fpp.f90:476
m_global_parameters::fluid_pp
type(physical_parameters), dimension(num_fluids_max) fluid_pp
Database of the physical parameters of each of the fluids that is present in the flow....
Definition m_global_parameters.fpp.f90:948
m_global_parameters::chemxe
integer chemxe
Definition m_global_parameters.fpp.f90:1294
m_global_parameters::dir_idx_tau
integer, dimension(3) dir_idx_tau
Definition m_global_parameters.fpp.f90:891
m_global_parameters::num_dims
integer num_dims
Number of spatial dimensions.
Definition m_global_parameters.fpp.f90:423
m_global_parameters::r0
real(wp), dimension(:), allocatable r0
Bubble sizes.
Definition m_global_parameters.fpp.f90:1049
m_global_parameters::chem_params
type(chemistry_parameters) chem_params
Definition m_global_parameters.fpp.f90:1170
m_global_parameters::num_vels
integer num_vels
Number of velocity components (different from num_dims for mhd).
Definition m_global_parameters.fpp.f90:424
m_global_parameters::polytropic
logical polytropic
Polytropic switch.
Definition m_global_parameters.fpp.f90:1063
m_global_parameters::re_idx
integer, dimension(:, :), allocatable re_idx
Definition m_global_parameters.fpp.f90:848
m_global_parameters::strxb
integer strxb
Definition m_global_parameters.fpp.f90:1293
m_global_parameters::qbmm
logical qbmm
Quadrature moment method.
Definition m_global_parameters.fpp.f90:1122
m_global_parameters::damage_idx
integer damage_idx
Index of damage state variable (D) for continuum damage model.
Definition m_global_parameters.fpp.f90:774
m_global_parameters::hyper_cleaning
logical hyper_cleaning
Hyperbolic cleaning for MHD for divB=0.
Definition m_global_parameters.fpp.f90:486
m_global_parameters::bx0
real(wp) bx0
Constant magnetic field in the x-direction (1D).
Definition m_global_parameters.fpp.f90:1392
m_global_parameters::contxe
integer contxe
Definition m_global_parameters.fpp.f90:1290
m_global_parameters::b_size
integer b_size
Number of elements in the symmetric b tensor, plus one.
Definition m_global_parameters.fpp.f90:770
m_global_parameters::qvs
real(wp), dimension(:), allocatable qvs
Definition m_global_parameters.fpp.f90:1341
m_global_parameters::pi_infs
real(wp), dimension(:), allocatable pi_infs
Definition m_global_parameters.fpp.f90:1341
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:1077
m_global_parameters::dir_flg
real(wp), dimension(3) dir_flg
Definition m_global_parameters.fpp.f90:890
m_global_parameters::mhd
logical mhd
Magnetohydrodynamics.
Definition m_global_parameters.fpp.f90:444
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:924
m_global_parameters::e_idx
integer e_idx
Index of energy equation.
Definition m_global_parameters.fpp.f90:759
m_global_parameters::n
integer n
Definition m_global_parameters.fpp.f90:331
m_global_parameters::surface_tension
logical surface_tension
Definition m_global_parameters.fpp.f90:1274
m_global_parameters::intxb
integer intxb
Definition m_global_parameters.fpp.f90:1291
m_global_parameters::elasticity
logical elasticity
elasticity modeling, true for hyper or hypo
Definition m_global_parameters.fpp.f90:481
m_global_parameters::nb
integer nb
Number of eq. bubble sizes.
Definition m_global_parameters.fpp.f90:1029
m_global_parameters::c_idx
integer c_idx
Index of color function.
Definition m_global_parameters.fpp.f90:773
m_global_parameters::mpp_lim
logical mpp_lim
Mixture physical parameters (MPP) limits.
Definition m_global_parameters.fpp.f90:426
m_global_parameters::low_mach
integer low_mach
Low Mach number fix to HLLC Riemann solver.
Definition m_global_parameters.fpp.f90:469
m_global_parameters::psi_idx
integer psi_idx
Index of hyperbolic cleaning state variable for MHD.
Definition m_global_parameters.fpp.f90:775
m_global_parameters::shear_stress
logical shear_stress
Shear stresses.
Definition m_global_parameters.fpp.f90:483
m_global_parameters::relativity
logical relativity
Relativity (only for MHD).
Definition m_global_parameters.fpp.f90:445
m_global_parameters::gammas
real(wp), dimension(:), allocatable gammas
Definition m_global_parameters.fpp.f90:1341
m_global_parameters::intxe
integer intxe
Definition m_global_parameters.fpp.f90:1291
m_global_parameters::bubxe
integer bubxe
Definition m_global_parameters.fpp.f90:1292
m_global_parameters::alf_idx
integer alf_idx
Index of void fraction.
Definition m_global_parameters.fpp.f90:764
m_global_parameters::advxb
integer advxb
Definition m_global_parameters.fpp.f90:1289
m_global_parameters::momxb
integer momxb
Definition m_global_parameters.fpp.f90:1288
m_helper_basic
Basic floating-point utilities: approximate equality, default detection, and coordinate bounds.
Definition m_helper_basic.fpp.f90:292
m_mpi_proxy
MPI halo exchange, domain decomposition, and buffer packing/unpacking for the simulation solver.
Definition m_mpi_proxy.fpp.f90:303
m_riemann_solvers
Approximate and exact Riemann solvers (HLL, HLLC, HLLD, exact) for the multicomponent Navier–Stokes e...
Definition m_riemann_solvers.fpp.f90:313
m_riemann_solvers::s_hlld_riemann_solver
subroutine, public s_hlld_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
HLLD Riemann solver resolves 5 of the 7 waves of MHD equations: 1 entropy wave, 2 Alfvén waves,...
Definition m_riemann_solvers.fpp.f90:16814
m_riemann_solvers::is2
type(int_bounds_info) is2
Definition m_riemann_solvers.fpp.f90:444
m_riemann_solvers::flux_gsrc_rsx_vf
real(wp), dimension(:, :, :, :), allocatable flux_gsrc_rsx_vf
The cell-boundary values of the geometrical source flux that are computed through the chosen Riemann ...
Definition m_riemann_solvers.fpp.f90:378
m_riemann_solvers::flux_gsrc_rsz_vf
real(wp), dimension(:, :, :, :), allocatable flux_gsrc_rsz_vf
Definition m_riemann_solvers.fpp.f90:380
m_riemann_solvers::mom_sp_rsx_vf
real(wp), dimension(:, :, :, :), allocatable mom_sp_rsx_vf
Definition m_riemann_solvers.fpp.f90:412
m_riemann_solvers::s_hll_riemann_solver
subroutine, public s_hll_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
Computes intercell fluxes using the Harten-Lax-van Leer (HLL) approximate Riemann solver.
Definition m_riemann_solvers.fpp.f90:689
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)
Computes cylindrical viscous source flux contributions for momentum and energy. Calculates Cartesian ...
Definition m_riemann_solvers.fpp.f90:20244
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)
Computes Cartesian viscous source flux contributions for momentum and energy. Calculates averaged vel...
Definition m_riemann_solvers.fpp.f90:20474
m_riemann_solvers::s_calculate_bulk_stress_tensor
subroutine s_calculate_bulk_stress_tensor(re_bulk, divergence_v, tau_bulk_out)
Calculates bulk stress tensor components (diagonal only). tau_ii_bulk = (div_v) / Re_bulk....
Definition m_riemann_solvers.fpp.f90:20684
m_riemann_solvers::vel_src_rsx_vf
real(wp), dimension(:, :, :, :), allocatable vel_src_rsx_vf
Definition m_riemann_solvers.fpp.f90:397
m_riemann_solvers::is1
type(int_bounds_info) is1
Definition m_riemann_solvers.fpp.f90:444
m_riemann_solvers::s_populate_riemann_states_variables_buffers
subroutine s_populate_riemann_states_variables_buffers(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, norm_dir, ix, iy, iz)
The purpose of this subroutine is to populate the buffers of the left and right Riemann states variab...
Definition m_riemann_solvers.fpp.f90:18392
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:20727
m_riemann_solvers::mom_sp_rsy_vf
real(wp), dimension(:, :, :, :), allocatable mom_sp_rsy_vf
Definition m_riemann_solvers.fpp.f90:413
m_riemann_solvers::isx
type(int_bounds_info) isx
Definition m_riemann_solvers.fpp.f90:445
m_riemann_solvers::vel_src_rsz_vf
real(wp), dimension(:, :, :, :), allocatable vel_src_rsz_vf
Definition m_riemann_solvers.fpp.f90:399
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:21312
m_riemann_solvers::s_hllc_riemann_solver
subroutine, public s_hllc_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
This procedure is the implementation of the Harten, Lax, van Leer, and contact (HLLC) approximate Rie...
Definition m_riemann_solvers.fpp.f90:7151
m_riemann_solvers::s_calculate_shear_stress_tensor
subroutine s_calculate_shear_stress_tensor(vel_grad_avg, re_shear, divergence_v, tau_shear_out)
Calculates shear stress tensor components. tau_ij_shear = ( (dui/dxj + duj/dxi) - (2/3)*(div_v)*delta...
Definition m_riemann_solvers.fpp.f90:20636
m_riemann_solvers::res_gs
real(wp), dimension(:, :), allocatable res_gs
Definition m_riemann_solvers.fpp.f90:473
m_riemann_solvers::mom_sp_rsz_vf
real(wp), dimension(:, :, :, :), allocatable mom_sp_rsz_vf
Definition m_riemann_solvers.fpp.f90:414
m_riemann_solvers::re_avg_rsx_vf
real(wp), dimension(:, :, :, :), allocatable re_avg_rsx_vf
Definition m_riemann_solvers.fpp.f90:427
m_riemann_solvers::is3
type(int_bounds_info) is3
Definition m_riemann_solvers.fpp.f90:444
m_riemann_solvers::flux_rsy_vf
real(wp), dimension(:, :, :, :), allocatable flux_rsy_vf
Definition m_riemann_solvers.fpp.f90:358
m_riemann_solvers::vel_src_rsy_vf
real(wp), dimension(:, :, :, :), allocatable vel_src_rsy_vf
Definition m_riemann_solvers.fpp.f90:398
m_riemann_solvers::s_lf_riemann_solver
subroutine, public s_lf_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
Computes intercell fluxes using the Lax-Friedrichs (LF) approximate Riemann solver.
Definition m_riemann_solvers.fpp.f90:4157
m_riemann_solvers::s_initialize_riemann_solver
subroutine s_initialize_riemann_solver(flux_src_vf, norm_dir)
The computation of parameters, the allocation of memory, the association of pointers and/or the execu...
Definition m_riemann_solvers.fpp.f90:19724
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:357
m_riemann_solvers::flux_gsrc_rsy_vf
real(wp), dimension(:, :, :, :), allocatable flux_gsrc_rsy_vf
Definition m_riemann_solvers.fpp.f90:379
m_riemann_solvers::re_avg_rsz_vf
real(wp), dimension(:, :, :, :), allocatable re_avg_rsz_vf
Definition m_riemann_solvers.fpp.f90:429
m_riemann_solvers::re_avg_rsy_vf
real(wp), dimension(:, :, :, :), allocatable re_avg_rsy_vf
Definition m_riemann_solvers.fpp.f90:428
m_riemann_solvers::flux_src_rsy_vf
real(wp), dimension(:, :, :, :), allocatable flux_src_rsy_vf
Definition m_riemann_solvers.fpp.f90:358
m_riemann_solvers::flux_rsz_vf
real(wp), dimension(:, :, :, :), allocatable flux_rsz_vf
Definition m_riemann_solvers.fpp.f90:359
m_riemann_solvers::flux_src_rsx_vf
real(wp), dimension(:, :, :, :), allocatable flux_src_rsx_vf
Definition m_riemann_solvers.fpp.f90:357
m_riemann_solvers::isy
type(int_bounds_info) isy
Definition m_riemann_solvers.fpp.f90:445
m_riemann_solvers::s_initialize_riemann_solvers_module
impure subroutine, public s_initialize_riemann_solvers_module
The computation of parameters, the allocation of memory, the association of pointers and/or the execu...
Definition m_riemann_solvers.fpp.f90:17593
m_riemann_solvers::flux_src_rsz_vf
real(wp), dimension(:, :, :, :), allocatable flux_src_rsz_vf
Definition m_riemann_solvers.fpp.f90:359
m_riemann_solvers::isz
type(int_bounds_info) isz
Definition m_riemann_solvers.fpp.f90:445
m_riemann_solvers::gs_rs
real(wp), dimension(:), allocatable gs_rs
Definition m_riemann_solvers.fpp.f90:460
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:636
m_riemann_solvers::s_riemann_solver
subroutine, public s_riemann_solver(ql_prim_rsx_vf, ql_prim_rsy_vf, ql_prim_rsz_vf, dql_prim_dx_vf, dql_prim_dy_vf, dql_prim_dz_vf, ql_prim_vf, qr_prim_rsx_vf, qr_prim_rsy_vf, qr_prim_rsz_vf, dqr_prim_dx_vf, dqr_prim_dy_vf, dqr_prim_dz_vf, qr_prim_vf, q_prim_vf, flux_vf, flux_src_vf, flux_gsrc_vf, norm_dir, ix, iy, iz)
Dispatch to the subroutines that are utilized to compute the Riemann problem solution....
Definition m_riemann_solvers.fpp.f90:536
m_surface_tension
Computes capillary source fluxes and color-function gradients for the diffuse-interface surface tensi...
Definition m_surface_tension.fpp.f90:306
m_surface_tension::s_compute_capillary_source_flux
subroutine, public s_compute_capillary_source_flux(vsrc_rsx_vf, vsrc_rsy_vf, vsrc_rsz_vf, flux_src_vf, id, isx, isy, isz)
Computes the capillary (surface-tension) source flux from reconstructed color-gradient fields.
Definition m_surface_tension.fpp.f90:719
m_variables_conversion
Conservative-to-primitive variable conversion, mixture property evaluation, and pressure computation.
Definition m_variables_conversion.fpp.f90:303
m_variables_conversion::s_compute_fast_magnetosonic_speed
subroutine s_compute_fast_magnetosonic_speed(rho, c, b, norm, c_fast, h)
Computes the fast magnetosonic wave speed from the sound speed, density, and magnetic field component...
Definition m_variables_conversion.fpp.f90:2756
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)
Computes the speed of sound from thermodynamic state variables, supporting multiple equation-of-state...
Definition m_variables_conversion.fpp.f90:2664
m_derived_types::int_bounds_info
Integer bounds for variables.
Definition m_derived_types.fpp.f90:381
m_derived_types::riemann_states_vec3
Left and right Riemann states for 3-component vectors.
Definition m_derived_types.fpp.f90:375
m_derived_types::riemann_states
Left and right Riemann states.
Definition m_derived_types.fpp.f90:369
m_derived_types::scalar_field
Derived type annexing a scalar field (SF).
Definition m_derived_types.fpp.f90:307